use warnings;
use strict;

use Data::Dumper;
use GD::Graph::xylinespoints;
use Getopt::Long;
use RDB;

eval { main () };
print STDERR "# $0: ", $@
    and exit 1 
        if $@;
exit 0;

sub main {

    # read in cmd line args:
    #
    my %pars = parse_args ();

    # read in cmd line args:
    #
    my $graph  = init_plot ( %pars );
    my $r_data = read_data ( @pars{'filename','x','y'} );
    draw_data ( $graph, $r_data );

    system "xv $pars{outfile}" if $pars{display};
}

sub read_data {
    my $filename = shift or die "no filename in read_data";
    my $xcol     = shift or die "no     xcol in read_data";
    my $ycol     = shift or die "no     ycol in read_data";

    my ( $r_line, $r_data ) = ( {}, [] );

    my $rdb = new RDB;
    $rdb->open ( $filename eq 'stdin' ? \*STDIN : $filename ) 
        or die "RDB open $filename failed";

    while ( $rdb->read( $r_line ) ) {
        push @{$r_data->[0]}, $r_line->{ $xcol }; 
        push @{$r_data->[1]}, $r_line->{ $ycol }; 
    }
    return $r_data;
}

sub init_plot {

    my %pars = @_;

    my $graph = GD::Graph::xylinespoints->new ( 800, 600 );

    $graph->set(
        t_margin          => 10,
        b_margin          => 10,
        r_margin          => 30,
        l_margin          => 10,

        transparent       => 0,

        x_label           => $pars{xlabel},
        y_label           => $pars{ylabel},
        title             => $pars{title},
        x_tick_number     => 5,
        y_tick_number     => 5,
        x_number_format   => $pars{axis_fmt},
        y_number_format   => $pars{axis_fmt},
    ) or die $graph->error;

    return $graph;
}

sub draw_data {
    my $graph   = shift or die "no graph object in draw_data";
    my $r_data  = shift or die "no data in draw data";
    my $fmt     = shift || "png";
    my $outfile = shift || "tmp.$fmt";

    my $gd = $graph->plot( $r_data )
        or die $graph->error ();

    open my $img_fh, '>' . $outfile or die "$!";
    binmode $img_fh;
    print $img_fh $gd->$fmt ();
    close $img_fh;
}

sub parse_args {

    my %pars = ( 

        title    => '',
        xlabel   => '',
        ylabel   => '',

        x        => undef,
        y        => undef, 

        axis_fmt => '%.2f',

        filename => 'stdin',
        outfile  => 'tmp',
        img_fmt  => 'png',

        display  => 1,
        defaults => 0,
    );

    GetOptions (
        \%pars,
        qw{
            title=s
            xlabel=s
            ylabel=s

            x=s
            y=s

            axis_fmt=s

            filename=s
            img_fmt=s
            outfile=s

            display!
            defaults
        }
    );
    @pars{'x','y'} = x_y_names ( $pars{filename} )
        if ! defined $pars{x} && ! defined $pars{y};

    $pars{outfile} .= ".$pars{img_fmt}";
    $pars{xlabel}   = "$pars{x}"             if '' eq $pars{xlabel};
    $pars{ylabel}   = "$pars{y}"             if '' eq $pars{ylabel};
    $pars{title}    = "$pars{y} vs $pars{x}" if '' eq $pars{title};



    die Data::Dumper->Dump( [ \%pars ], [ qw( pars ) ] ),
       "Printing defaults and exiting on user request"
            if ( $pars{defaults} );
    return %pars;
}

sub x_y_names {

    my $file = shift () or die "no file in x_y_names";

    my $tmpfile = '.plot_gdgraph.hdr';

    if ( 'stdin' eq $file ) {
        unlink $tmpfile if -e $tmpfile;

        open my $write_fh, '>', $tmpfile;
        print $write_fh $_ while <>;
        close $write_fh;

        $file = $tmpfile;
    }

    my $definition_line = '#';

    open my $read_fh, '<', $file;
    chomp ( $definition_line = <$read_fh> )
        while $definition_line =~ /^\s*#/;
    close $read_fh;

    return ( split /\t/, $definition_line )[0,1];
}
[download]