package Lire::ChartType;

use strict;

use base qw/Lire::Plugin/;

use Lire::Utils qw/check_param check_object_param tempdir shell_quote file_content/;
use Carp;

=pod

=head1 NAME

Lire::ChartType - Base interface for all ChartType.

=head1 SYNOPSIS

  use base qw/ Lire::ChartType /;

=head1 DESCRIPTION

This package defines the interface which is implemented by all the
different charts that Lire is able to produce using the ploticus pl(1)
command.

A chart type will generate a chart using data from a subreport.

=head1 META INFORMATION METHODS

The Lire::ChartType interface extends the Lire::Plugin interface, so
they must implement all standard meta-information methods (name(),
title(), description()).

=cut

sub type { return 'chart_type' }

=head1 GENERATING A CHART

=head2 write_chart( $chart_config, $subreport, [ %params ] )

This will write a chart from the data contained in the
Lire::Report::Subreport $subreport using the configuration
$chart_config. Additional parameters are passed in 'key' => $value
form. The $chart_config parameters should be a
Lire::Config::Dictionary object instantiated from a
Lire::Config::ChartSpec.

=over 4

=item outputdir

Directory where the file will be created. Use the working directory by
default.

=item format

One of eps, png, jpeg or gif. Default to the configuration variable
lr_image_format.

=back

The function returns the path to the created file. The filename is
generated base on the 'name' configuration value or the subreport's id
if the other isn't defined. The extension is added based on the output format.

It returns the file where the chart was written.

=cut

sub write_chart {
    my ( $self, $chart_config, $subreport, %params ) = @_;

    check_object_param( $subreport, 'subreport', 'Lire::Report::Subreport' );
    check_object_param( $chart_config, 'chart_config',
                        'Lire::Report::ChartConfig' );

    $params{'format'} ||= Lire::Config->get( 'lr_image_format' );
    check_param( $params{'format'}, 'format', qr/^(eps|gif|jpeg|png)$/,
                 "'format' should be one of 'eps', 'gif', 'jpeg' or 'png'" );

    $params{'errfile'} = tempdir( 'Lire::ChartType_XXXXXX', 'CLEANUP' => 1 )
       . "/errfile";
    $params{'outputdir'} ||= '.';

    croak "cannot write to directory '$params{'outputdir'}"
      unless -d $params{'outputdir'} && -w $params{'outputdir'};

    croak "'ploticus_path' configuration variable isn't valid"
      unless Lire::Config->get_var( 'ploticus_path' )->is_valid();

    $subreport->table_info()->set_variables_indices();
    croak "invalid chart configuration"
      unless $chart_config->is_valid();

    return undef unless $subreport->entries();

    $params{'outputfile'} = $self->_outputfile( $chart_config, $subreport,
                                                \%params );

    my $cmdline = $self->_pl_cmdline( \%params );
    open my $pl, "|$cmdline"
      or die "failed to fork: $!\n";
    $self->write_parameters( $chart_config, $pl );
    $self->write_data( $chart_config, $subreport, $pl );
    die "Ploticus error: " . file_content( $params{'errfile'} )
      unless close $pl;

    return $params{'outputfile'};
}

sub _outputfile {
    my ( $self, $chart_cfg, $subreport, $params ) = @_;

    return $params->{'outputdir'} . "/"
      . ( $chart_cfg->get( 'name' )->as_value() || $subreport->id() )
      . "." . ( $params->{'format'} eq 'jpeg' ? 'jpg' : $params->{'format'} );
}

sub _pl_cmdline {
    my ( $self, $params ) = @_;

    $params->{'font'} ||= Lire::Config->get( 'lr_chart_font' );

    return join( " ", Lire::Config->get( 'ploticus_path' ),
                 $self->prefab(),
                 'data=-', 'delim=tab', 'header=yes',
                 "-$params->{'format'}", 
                 "-o", shell_quote( $params->{'outputfile'} ),
                 ( $params->{'font'}
                   ? ( '-font', shell_quote( $params->{'font'}) ) : '' ),
                 "2>", $params->{'errfile'}
               );
}

=pod

=head2 prefab()

This method must be implemented by the subclass and should return a
string representing the first parameters to pass to ploticus (that is
either -prefab name or the path to a script file).

=cut

sub prefab {
    croak ref shift, "::get_vars unimplemented";
}

=pod

=head2 write_parameters( $chart_config, $fh )

This method is used to write parameters to the ploticus file handle.
This is the place to use the #set command to set all of the prefabs
parameters. Subclass must chain to this implementation for the
standard chart parameters. It also write '#set name' directives for
each numerical variables defined by get_vars().

=cut

sub write_parameters {
    my ( $self, $chart_config, $fh ) = @_;

    print $fh "#set x = 1\n";
    my $title = $chart_config->get( 'title' )->as_value();
    print $fh "#set title = $title\n" if $title;
    my $xlabel = $chart_config->get( 'xlabel' )->as_value();
    print $fh "#set xlbl = $xlabel\n" if $xlabel;
    my $ylabel = $chart_config->get( 'ylabel' )->as_value();
    print $fh "#set ylbl = $ylabel\n" if $ylabel;

    my $idx = 1;
    foreach my $var ( @{$self->get_vars( $chart_config )} ) {
        next if $var->class() eq 'categorical';
        my $name = $idx == 1 ? 'name' : 'name' . $idx;
        print $fh "#set $name = ", $var->label(), "\n";
        $idx++;
    }
    return;
}

=pod

=head2 write_data( $chart_config, $subreport, $fh )

This method is used by the write_chart() implementation to write the
chart data from $subreport to the Ploticus commond opened on $fh. It
uses the get_vars() method to obtain the numerical variables that
should be written to the stream and the encode_value() method to
marshall values before writing them. 
Before any data is written to $fh the maximum value on the Y axis
is determined and output as a ploticus setting. (ploticus fails if
this is not set, a single bar is drawn and the value is greater than
1.1e9.)

=cut

sub write_data {
    my ( $self, $chart_config, $subreport, $fh ) = @_;

    my $case_var = $chart_config->get( 'case_var' )->as_value();
    my @vars = ( $case_var, @{ $self->get_vars( $chart_config ) } );
    print $fh join( "\t", map { $_->name() } @vars ), "\n";

    my @slice = map { $_->col_start() } @vars;
    my @rows = ();
    for ( my $i=0; $i < $subreport->nrows(); $i++ ) {
        my $row = $subreport->getrow_by_idx( $i );
        next unless defined $row->[ $case_var->col_start() ];
        push @rows, [ map { $self->encode_value( $_ ) } 
                        @{$row}[@slice] ];
    }

    my $yrange = -1;
    foreach my $ro (@rows) {
	my ($x, @values) = @{$ro};
        foreach my $value (@values) {
	    $yrange = $value
		if( $value =~ /^[+-]?[0-9]+\.?[0-9]*(e[+-]?[0-9]+)?$/
		&& $value > $yrange );
	}
    }
    if( $yrange > 0 ) {
    	print $fh "#set yrange 0 $yrange\n";
    } else {
    	print $fh "#set yrange 0\n";
    }

    foreach my $r (@rows) {
        print $fh join( "\t", @{$r} ), "\n";
    }
    return ;
}

=pod

=head2 get_vars( $chart_config )

This method should be overriden by subclasses to return an array
reference containing the Lire::Report::ColumnInfo specifying the
numerical column's of data that should be written. This is usually
specified using a ReferenceSpec with the 'numerical_variables' index.

These variables will start at the ploticus index 2 (@2).

=cut

sub get_vars {
    croak ref shift, "::get_vars unimplemented";
}

=pod

=head2 encode_value( $value )

By default, this method just returns the 'content' component of the
item when the $value is a name and the 'value' component otherwise. It
can used for data type that needs special encoding (like datetime).

=cut

sub encode_value {
    return $_[1]{'type'} eq 'name' ? $_[1]{'content'}
      : ( $_[1]{'value'} eq 'NaN' ? 'NA' : $_[1]{'value'} );
}

# keep perl happy
1;

__END__

=pod

=head1 SEE ALSO

 Lire::PluginManager(3pm) Lire::Config::ChartSpec(3pm)

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: ChartType.pm,v 1.17 2006/07/29 18:01:14 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2004 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.

=cut

