package ReportGen::Plot;
use strict;
#
# Wrapper for gnuplot-like control files
#
use ReportGen::Line;
require FileHandle;
$ReportGen::Plot::Plotter = undef();
my @labelCmds = map { ("x$_", "y$_", "x2$_", "y2$_") } qw( label );
my @ticCmds = map { ("x$_", "y$_", "x2$_", "y2$_") } qw( tics );
my @KnownCmds = (
@labelCmds,
map { ("$_", "no$_") } (@ticCmds, qw( title grid timestamp )),
qw( data size ),
);
sub new {
my ($proto, $name) = @_;
my $type = ref($proto) || $proto;
my $this = bless({}, $type);
$this->{theName} = $name;
$this->{thetitle} = undef;
$this->{theTerm} = '';
$this->{theOFName} = '';
$this->{theOpt} = [];
$this->{theLines} = [];
$this->{theSets} = {};
return $this;
}
sub clone {
my ($this) = @_;
my $clone = bless({}, ref($this));
$clone->{theName} = $this->{theName};
$clone->{theTitle} = $this->{theTitle};
$clone->{theTerm} = $this->{theTerm};;
$clone->{theOFName} = $this->{theOFName};
$clone->{theOpt} = [ @{$this->{theOpt}} ];
$clone->{theLines} = [ map { $_-> clone() } @{$this->{theLines}} ];
$clone->{theSets} = {
map { $_ => $this->{theSets}->{$_} } keys %{$this->{theSets}}
};
return $clone;
}
sub ofile { return shift->{theOFName}; }
sub name {
my ($this, $name) = @_;
$this->{theName} = $name if defined $name;
return $this->{theName};
}
sub title {
my ($this, $title) = @_;
$this->{theTitle} = $title if defined $title;
return $this->{theTitle};
}
sub opt {
my ($this, $cmd_name, $opt_name, @flds) = @_;
die() unless $cmd_name;
if ($cmd_name =~ /^set$/i) {
$this->{theSets}->{$opt_name} = join(' ', @flds);
}
push @{$this->{theOpt}}, join(' ', $cmd_name, $opt_name, @flds);
}
sub set {
my $this = shift;
$this->opt('set', @_);
}
sub isSet {
my ($this, $name) = @_;
my $opt = $this->{theSets}->{$name};
return (defined $opt) ? $opt || ' ' : undef();
}
sub line {
my ($this, @lines) = @_;
foreach (@lines) {
push @{$this->{theLines}}, $_;
}
}
sub lines {
my $this = shift;
return ( @{$this->{theLines}} );
}
sub gif {
my ($this, @opt) = @_;
$this->terminal('gif', @opt);
}
sub postscript {
my ($this, @opt) = @_;
$this->terminal('postscript', @opt);
}
sub terminal {
my ($this, @opt) = @_;
$this->{theTerm} = join(' ', @opt);
}
sub output {
my ($this, $ofname) = @_;
$this->{theOFName} = $ofname;
}
sub tics {
my ($this, $axis, @tics) = @_;
my $tics = ' ';
while (@tics) {
my $label = shift @tics;
my $val = shift @tics;
$tics .= sprintf('"%s" %s,', $label, $val);
}
chop($tics);
$this->set("${axis}tics (", $tics, ')');
}
sub range {
my ($this, $axis, $lo, $hi) = @_;
$lo = '*' unless defined $lo;
$hi = '*' unless defined $hi;
$this->set("${axis}range [ $lo : $hi ]");
}
sub term2ext {
my ($this) = @_;
return '' unless $this->{theTerm};
return '.gif' if $this->{theTerm} =~ /^gif/;
return '.eps' if $this->{theTerm} =~ /^postscript/;
return '.png' if $this->{theTerm} =~ /^png/;
return '.txt' if $this->{theTerm} =~ /^dumb/;
return ".$1" if $this->{theTerm} =~ /^(\w+)/;
return '';
}
sub lineCount {
my ($this) = @_;
my @counts = $this->forEach('lineCount');
my $sum = 0;
foreach (@counts) { $sum += $_; }
return wantarray ? @counts : $sum;
}
sub forEach {
my ($this, $method, @params) = @_;
my @res = ();
foreach (@{$this->{theLines}}) {
push @res, $_->$method(@params);
}
return wantarray ? @res : scalar @res;
}
sub plot {
my ($this) = @_;
my $plotter = $ReportGen::Plot::Plotter;
my $f = new FileHandle("|$plotter") or die("cannot start $plotter, $!; stopped");
$f->print($this->image());
undef $f;
}
sub image {
my ($this) = @_;
my $image =
'# ' . ($this->{theName} || ''). "\n" .
'# ' . $this->{theOFName} . "\n";
'# ' . localtime() . "\n";
$image .= sprintf('set title "%s"', $this->{theTitle}) if $this->{theTitle};
$image .= join("\n", '', @{$this->{theOpt}});
$image .= "\nset term " . $this->{theTerm} if $this->{theTerm};
$image .= "\n" . sprintf('set output "%s"', $this->{theOFName}) if $this->{theOFName};
if (@{$this->{theLines}}) {
$image .= "\nplot \\\n" .
join(",\\\n",
map { "\t" . $_->image() } @{$this->{theLines}});
}
$image .= "\n";
return $image;
}
use vars qw($AUTOLOAD);
sub AUTOLOAD {
my $this = shift;
my $A = $AUTOLOAD;
$A =~ s/ReportGen::Plot:://;
return undef if $A eq 'DESTROY';
my $opt = lc $A;
my $quoted = $opt =~ s/_qw$//;
die("unknown plot command '$A', stopped") unless grep { /^$opt$/ } @KnownCmds;
if ($quoted) {
$this->set($opt, sprintf('"%s"', join(' ', @_)));
} else {
$this->set($opt, @_);
}
}
1;
syntax highlighted by Code2HTML, v. 0.9.1