package feedgnuplot;
use strict;
use warnings;
use Getopt::Long;
use Time::HiRes qw( usleep gettimeofday tv_interval );
use IO::Handle;
use IO::Select;
use List::Util qw( first );
use List::MoreUtils 'any';
use Scalar::Util qw( looks_like_number );
use Text::ParseWords; use Pod::Usage;
use Time::Piece;
my $VERSION = 1.44;
my %options;
interpretCommandline();
my @curves = ();
my %curveIndices = ();
my $haveNewData;
my $last_replot_time = [gettimeofday];
my $last_replot_is_from_timer = 1;
my $this_replot_is_from_timer;
sub getRangeSize
{
my ($id) = @_;
return
exists $options{rangesize_hash}{$id} ?
$options{rangesize_hash}{$id} :
$options{rangesize_default};
}
sub interpretCommandline
{
if (exists $ARGV[0] && !-r $ARGV[0])
{
unshift @ARGV, shellwords shift @ARGV;
}
$options{ maxcurves } = 100;
$options{ histstyle} = 'freq';
$options{legend} = [];
$options{curvestyle} = [];
$options{style} = [];
$options{histogram} = [];
$options{y2} = [];
$options{extracmds} = [];
$options{set} = [];
$options{unset} = [];
$options{equation} = [];
$options{curvestyleall} = '';
$options{styleall} = '';
$options{with} = '';
$options{rangesize} = [];
GetOptions(\%options, 'stream:s', 'domain!', 'dataid!', '3d!', 'colormap!', 'lines!', 'points!',
'circles', 'legend=s{2}', 'autolegend!', 'xlabel=s', 'ylabel=s', 'y2label=s', 'zlabel=s',
'title=s', 'xlen=f', 'ymin=f', 'ymax=f', 'xmin=s', 'xmax=s', 'y2min=f', 'y2max=f',
'zmin=f', 'zmax=f', 'y2=s@',
'style=s{2}', 'curvestyle=s{2}', 'curvestyleall=s', 'styleall=s', 'with=s', 'extracmds=s@', 'set=s@', 'unset=s@',
'square!', 'square_xy!', 'hardcopy=s', 'maxcurves=i', 'monotonic!', 'timefmt=s',
'equation=s@',
'image=s',
'histogram=s@', 'binwidth=f', 'histstyle=s',
'terminal=s',
'rangesize=s{2}', 'rangesizeall=i', 'extraValuesPerPoint=i',
'help', 'dump', 'exit', 'version',
'geometry=s') or exit 1;
if ( $options{help} )
{
pod2usage( -exitval => 0,
-verbose => 1, -output => \*STDOUT );
}
if( $options{version} )
{
print "feedgnuplot version $VERSION\n";
exit 0;
}
if( $options{styleall} )
{
if($options{curvestyleall} ) { $options{curvestyleall} .= " $options{styleall}"; }
else { $options{curvestyleall} = $options{styleall}; }
delete $options{styleall};
}
push @{$options{curvestyle}}, @{$options{style}};
delete $options{style};
if( $options{curvestyleall} && $options{with} )
{
print STDERR "--curvestyleall and --with are mutually exclusive. Please just use one.\n";
exit -1;
}
if( $options{with} )
{
$options{curvestyleall} = "with $options{with}";
delete $options{with};
}
for my $listkey (qw(histogram y2))
{
@{$options{$listkey}} = map split('\s*,\s*', $_), @{$options{$listkey}}
if defined $options{$listkey};
}
for my $listkey (qw(curvestyle rangesize))
{
next unless defined $options{$listkey};
my @in = @{$options{$listkey}};
my $N = @in / 2;
my @out;
for my $i (0..$N-1)
{
my $key = $in[2*$i];
my $value = $in[2*$i + 1];
for my $key_new (split('\s*,\s*', $key))
{
push @out, $key_new, $value;
}
}
@{$options{$listkey}} = @out;
}
if( !$options{curvestyleall} && $options{histstyle} =~ /freq|fnorm/ )
{
for my $hist_curve(@{$options{histogram}})
{
if( !any { $options{curvestyle}[$_*2] eq $hist_curve } 0..(@{$options{curvestyle}}/2 - 1) )
{
push @{$options{curvestyle}}, ($hist_curve, 'with boxes fill solid border lt -1');
}
}
}
for my $listkey (qw(legend curvestyle rangesize))
{
$options{"${listkey}_hash"} = {};
my $n = scalar @{$options{$listkey}}/2;
foreach my $idx (0..$n-1)
{
$options{"${listkey}_hash"}{$options{$listkey}[$idx*2]} = $options{$listkey}[$idx*2 + 1];
}
}
if ( defined $options{hardcopy} && defined $options{stream} )
{
print STDERR "--stream doesn't make sense together with --hardcopy\n";
exit -1;
}
if ( defined $options{rangesizeall} && defined $options{extraValuesPerPoint} )
{
print STDERR "Only one of --rangesizeall and --extraValuesPerPoint may be given\n";
exit -1;
}
if ( $options{rangesizeall} )
{
$options{rangesize_default} = $options{rangesizeall};
}
else
{
$options{rangesize_default} = 1;
$options{rangesize_default} += $options{extraValuesPerPoint} if ($options{extraValuesPerPoint});
$options{rangesize_default}++ if ($options{colormap});
$options{rangesize_default}++ if ($options{circles} );
}
if(defined $options{stream})
{
$options{stream} = 1 if $options{stream} eq '';
if( !looks_like_number $options{stream} )
{
if($options{stream} eq 'trigger')
{
$options{stream} = 0;
}
else
{
print STDERR "--stream can only take in values >=0 or 'trigger'\n";
exit -1;
}
}
if ( $options{stream} == 0 )
{
$options{stream} = -1;
}
elsif ( $options{stream} <= 0)
{
print STDERR "--stream can only take in values >=0 or 'trigger'\n";
exit -1;
}
}
if ($options{colormap})
{
$options{curvestyleall} .= ' palette';
}
if ( defined $options{binwidth} && !@{$options{histogram}} )
{
print STDERR "--binwidth doesn't make sense without any histograms\n";
exit -1;
}
if ( $options{'3d'} )
{
if ( !$options{domain} )
{
print STDERR "--3d only makes sense with --domain\n";
exit -1;
}
if ( $options{timefmt} )
{
print STDERR "--3d makes no sense with --timefmt\n";
exit -1;
}
if ( defined $options{y2min} || defined $options{y2max} || @{$options{y2}} )
{
print STDERR "--3d does not make sense with --y2...\n";
exit -1;
}
if ( defined $options{xlen} )
{
print STDERR "--3d does not make sense with --xlen\n";
exit -1;
}
if ( defined $options{monotonic} )
{
print STDERR "--3d does not make sense with --monotonic\n";
exit -1;
}
if ( @{$options{histogram}} )
{
print STDERR "--3d does not make sense with histograms\n";
exit -1;
}
if ( defined $options{circles} )
{
print STDERR "--3d does not make sense with circles (gnuplot doesn't support this)\n";
exit -1;
}
}
else
{
if ( $options{timefmt} && !$options{domain} )
{
print STDERR "--timefmt makes sense only with --domain\n";
exit -1;
}
if(!$options{colormap})
{
if ( defined $options{zmin} || defined $options{zmax} || defined $options{zlabel} )
{
print STDERR "--zmin/zmax/zlabel only makes sense with --3d or --colormap\n";
exit -1;
}
}
if ( defined $options{square_xy} )
{
print STDERR "--square_xy only makes sense with --3d\n";
exit -1;
}
for my $hist_curve(@{$options{histogram}})
{
my $hist_dim = getRangeSize($hist_curve);
if( $hist_dim != 1 )
{
print STDERR "I only support 1D histograms, but curve '$hist_curve' has '$hist_dim'-D data\n";
exit -1;
}
}
}
if(defined $options{xlen} && !$options{stream} )
{
print STDERR "--xlen does not make sense without --stream\n";
exit -1;
}
if($options{stream} && defined $options{xlen} &&
( defined $options{xmin} || defined $options{xmax}) &&
!defined $options{histogram})
{
print STDERR "With --stream and --xlen the X bounds are set, so neither --xmin nor --xmax make sense\n";
exit -1;
}
$options{monotonic} = 1 if defined $options{xlen};
if( $options{histstyle} !~ /freq|cum|uniq|cnorm|fnorm/ )
{
print STDERR "unknown histstyle. Allowed are 'freq...', 'fnorm...', 'cum...', 'uniq...', 'cnorm...'\n";
exit -1;
}
if ( $options{timefmt} )
{
$options{timefmt} =~ s/^\s*//;
$options{timefmt} =~ s/\s*$//;
my $Nfields = () = split /\s+/, $options{timefmt}, -1;
$options{timefmt_Ncols} = $Nfields;
if( defined $options{xlen} )
{
if( $options{xlen} - int($options{xlen}) )
{
print STDERR "When streaming --xlen MUST be an integer. Rounding up to the nearest second\n";
$options{xlen} = 1 + int($options{xlen});
}
}
}
if( defined $options{image} )
{
if( !defined $options{ymin} && !defined $options{ymax} &&
! any { /^ *yrange\b/ } @{$options{set}} )
{
push @{$options{set}}, "yrange [:] reverse";
}
if ( ! -r $options{image} )
{
die "Couldn't read image '$options{image}'";
}
unshift @{$options{equation}}, qq{"$options{image}" binary filetype=auto flipy with rgbimage};
delete $options{image};
}
}
sub getGnuplotVersion
{
open(GNUPLOT_VERSION, 'gnuplot --version |') or die "Couldn't run gnuplot";
my ($gnuplotVersion) = <GNUPLOT_VERSION> =~ /gnuplot\s*(\d*\.\d*)/;
if (!$gnuplotVersion)
{
print STDERR "Couldn't find the version of gnuplot. Does it work? Trying anyway...\n";
$gnuplotVersion = 0;
}
close(GNUPLOT_VERSION);
return $gnuplotVersion;
}
sub sendRangeCommand
{
my ($name, $min, $max) = @_;
return unless defined $min || defined $max;
if( defined $min )
{ $min = "\"$min\""; }
else
{ $min = ''; }
if( defined $max )
{ $max = "\"$max\""; }
else
{ $max = ''; }
my $cmd = "set $name [$min:$max]\n";
print PIPE $cmd;
}
sub makeDomainNumeric
{
my ($domain0) = @_;
if ( $options{timefmt} )
{
my $timepiece = Time::Piece->strptime( $domain0, $options{timefmt} )
or die "Couldn't parse time format. String '$domain0' doesn't fit format '$options{timefmt}'";
return $timepiece->epoch();
}
return $domain0;
}
my $prev_timed_replot_time = [gettimeofday];
my $pipe_in;
my $selector;
my $line_number = 0;
my $is_stdin = !@ARGV; sub openNextFile
{
my $fd;
if($is_stdin)
{
$fd = IO::Handle->new();
$fd->fdopen(fileno(STDIN), "r") or die "Couldn't open STDIN";
}
else
{
my $filename = shift @ARGV;
$fd = IO::File->new($filename, "r") or die "Couldn't open file '$filename'";
}
my $selector = IO::Select->new( $fd );
return ($fd, $selector);
}
sub getNextLine
{
sub getline_internal
{
while(1)
{
my $line = $pipe_in->getline();
if( !$is_stdin && !defined $line && $pipe_in->eof() && @ARGV)
{
($pipe_in, $selector) = openNextFile();
next;
}
return $line;
}
}
if( !defined $pipe_in )
{
($pipe_in, $selector) = openNextFile();
}
while(1)
{
$this_replot_is_from_timer = undef;
if (! $options{stream} || $options{stream} < 0)
{
$line_number++;
return getline_internal();
}
my $now = [gettimeofday];
my $time_remaining = $options{stream} - tv_interval($prev_timed_replot_time, $now);
if ( $time_remaining < 0 )
{
$prev_timed_replot_time = $now;
$this_replot_is_from_timer = 1;
return 'replot';
}
if ($selector->can_read($time_remaining))
{
$line_number++;
return getline_internal();
}
}
}
sub mainThread
{
local *PIPE;
my $dopersist = '';
if( getGnuplotVersion() >= 4.3 &&
!$options{stream} && $options{exit})
{
$dopersist = '--persist';
}
if ($options{stream} && !$options{exit})
{
$SIG{INT} = sub
{
print STDERR "$0 received SIGINT. Send again to quit\n";
$SIG{INT} = undef;
};
}
if(exists $options{dump})
{
*PIPE = *STDOUT;
}
else
{
my $geometry = defined $options{geometry} ?
"-geometry $options{geometry}" : '';
open PIPE, "|gnuplot $geometry $dopersist" or die "Can't initialize gnuplot\n";
}
autoflush PIPE 1;
my $outputfile;
my $outputfileType;
if( defined $options{hardcopy})
{
$outputfile = $options{hardcopy};
if( $outputfile =~ /^[^|] # starts with anything other than |
.* # stuff in the middle
\.(eps|ps|pdf|png|svg)$/ix) {
$outputfileType = lc $1;
}
my %terminalOpts =
( eps => 'postscript noenhanced solid color enhanced eps',
ps => 'postscript noenhanced solid color landscape 12',
pdf => 'pdfcairo noenhanced solid color font ",12" size 11in,8.5in',
png => 'png noenhanced size 1280,1024',
svg => 'svg noenhanced');
if( !defined $options{terminal} &&
defined $outputfileType &&
$terminalOpts{$outputfileType} )
{
$options{terminal} = $terminalOpts{$outputfileType};
}
die "Asked to plot to file '$outputfile', but I don't know which terminal to use, and no --terminal given"
unless $options{terminal};
}
print PIPE "set terminal $options{terminal}\n" if $options{terminal};
print PIPE "set output \"$outputfile\"\n" if $outputfile;
my $style = '';
if($options{lines}) { $style .= 'lines';}
if($options{points}) { $style .= 'points';}
if($options{circles})
{
$options{curvestyleall} = "with circles $options{curvestyleall}";
}
print PIPE "set style data $style\n" if $style;
print PIPE "set grid\n";
print(PIPE "set xlabel \"$options{xlabel }\"\n") if defined $options{xlabel};
print(PIPE "set ylabel \"$options{ylabel }\"\n") if defined $options{ylabel};
print(PIPE "set zlabel \"$options{zlabel }\"\n") if defined $options{zlabel};
print(PIPE "set y2label \"$options{y2label}\"\n") if defined $options{y2label};
print(PIPE "set title \"$options{title }\"\n") if defined $options{title};
if($options{square})
{
if(! $options{'3d'})
{
print(PIPE "set size ratio -1\n");
}
else
{
print(PIPE "set view equal xyz\n");
}
}
if($options{square_xy})
{
print(PIPE "set view equal xy\n");
}
if(@{$options{legend}})
{
my $n = scalar @{$options{legend}}/2;
foreach my $idx (0..$n-1)
{
setCurveLabel($options{legend}[$idx*2 ],
$options{legend}[$idx*2 + 1]);
}
}
if(@{$options{curvestyle}})
{
my $n = scalar @{$options{curvestyle}}/2;
foreach my $idx (0..$n-1)
{
addCurveOption($options{curvestyle}[$idx*2 ],
$options{curvestyle}[$idx*2 + 1]);
}
}
addCurveOption($_, 'axes x1y2') foreach (@{$options{y2}});
if( $options{timefmt} )
{
print(PIPE "set timefmt '$options{timefmt}'\n");
print(PIPE "set xdata time\n");
}
print(PIPE "$_\n") foreach (@{$options{extracmds}});
print(PIPE "set $_\n") foreach (@{$options{set}});
print(PIPE "unset $_\n") foreach (@{$options{unset}});
$options{binwidth} ||= 1; print PIPE
"set boxwidth $options{binwidth}\n" .
"histbin(x) = $options{binwidth} * floor(0.5 + x/$options{binwidth})\n";
setCurveAsHistogram( $_ ) foreach (@{$options{histogram}});
if(@{$options{y2}})
{
print PIPE "set ytics nomirror\n";
print PIPE "set y2tics\n";
sendRangeCommand( "y2range", $options{y2min}, $options{y2max} );
}
sendRangeCommand( "xrange", $options{xmin}, $options{xmax} );
sendRangeCommand( "yrange", $options{ymin}, $options{ymax} );
sendRangeCommand( "zrange", $options{zmin}, $options{zmax} );
sendRangeCommand( "cbrange", $options{zmin}, $options{zmax} ) if($options{colormap});
my $latestX;
my @domain;
my $domain0_numeric;
while( defined ($_ = getNextLine()) )
{
next if /^#/o;
if( $options{stream} )
{
if(/^clear/o )
{
clearCurves();
next;
}
if(/^replot/o )
{
replot( $domain0_numeric );
next;
}
last if /^exit/o;
}
my @fields = split;
if($options{domain})
{
if( $options{timefmt} )
{
next if @fields < $options{timefmt_Ncols}+1;
$domain[0] = join (' ', splice( @fields, 0, $options{timefmt_Ncols}) );
$domain0_numeric = makeDomainNumeric( $domain[0] );
}
elsif(!$options{'3d'})
{
next if @fields < 1+1;
$domain[0] = $domain0_numeric = shift @fields;
}
else
{
next if @fields < 2+1;
@domain = splice(@fields, 0, 2);
}
if( $options{monotonic} )
{
if( defined $latestX && $domain0_numeric < $latestX )
{
replot( $domain0_numeric );
clearCurves();
$latestX = undef;
}
else
{ $latestX = $domain0_numeric; }
}
}
else
{
$domain[0] = $line_number;
$domain0_numeric = makeDomainNumeric( $domain[0] );
}
my $id = -1;
while(@fields)
{
if($options{dataid}) { $id = shift @fields; }
else { $id++; }
my $rangesize = getRangeSize($id);
last if @fields < $rangesize;
pushPoint(getCurve($id),
join(' ',
@domain,
splice( @fields, 0, $rangesize ) ) . "\n",
$domain0_numeric);
}
}
plotStoredData() unless $options{stream} && $options{exit};
if ( defined $options{hardcopy})
{
print PIPE "set output\n";
if( $options{hardcopy} !~ /^\|/ )
{
usleep(100_000) until -e $outputfile;
usleep(100_000) until(system("fuser -s \"$outputfile\""));
}
print "Wrote output to $outputfile\n";
return;
}
if($options{stream} && !$options{exit})
{
print STDERR "Input data exhausted\n";
$SIG{INT} = undef;
}
sleep(100000000) unless $options{dump} || $options{exit};
}
sub pruneOldData
{
my ($oldestx) = @_;
foreach my $curve (@curves)
{
next unless $curve->{datastring};
my $meta = $curve->{datastring_meta};
my $firstInWindow = first {$meta->[$_]{domain} >= $oldestx} 0..$#$meta;
if ( !defined $firstInWindow )
{
$curve->{datastring} = '';
$curve->{datastring_meta} = [];
$curve->{datastring_offset} = 0;
}
elsif ( $firstInWindow >= 2 )
{
substr( $curve->{datastring}, 0,
$meta->[$firstInWindow-1]{offset_start} - $curve->{datastring_offset},
'' );
$curve->{datastring_offset} = $meta->[$firstInWindow-1]{offset_start};
}
}
}
sub plotStoredData
{
my @nonemptyCurves = grep { $_->{datastring} } @curves;
my @extraopts = map {$_->{options}} @nonemptyCurves;
my $body = join('', map { "$_," } @{$options{equation}});
$body .= join(', ' , map({ "'-' $_" } @extraopts) );
if($options{'3d'}) { print PIPE "splot $body\n"; }
else { print PIPE "plot $body\n"; }
foreach my $curve (@nonemptyCurves)
{
print PIPE $curve->{datastring};
print PIPE "e\n";
}
}
sub updateCurveOptions
{
my ($curve, $id) = @_;
my $title;
if(defined $curve->{title})
{ $title = $curve->{title}; }
elsif( $options{autolegend} )
{ $title = $id; }
my $titleoption = defined $title ? "title \"$title\"" : "notitle";
my $histoptions = $curve->{histoptions} || '';
my $usingoptions = '';
if( $options{timefmt} )
{
my @rest = map {$_ + $options{timefmt_Ncols}} (1..getRangeSize($id));
$usingoptions = "using 1:" . join(':', @rest);
}
$curve->{options} = "$histoptions $usingoptions $titleoption $curve->{extraoptions} $options{curvestyleall}";
}
sub getCurve
{
if(scalar @curves >= $options{maxcurves})
{
print STDERR "Tried to exceed the --maxcurves setting.\n";
print STDERR "Invoke with a higher --maxcurves limit if you really want to do this.\n";
exit -1;
}
my ($id) = @_;
if( !exists $curveIndices{$id} )
{
push @curves, {extraoptions => ' ',
datastring => '',
datastring_meta => [],
datastring_offset => 0}; $curveIndices{$id} = $#curves;
updateCurveOptions($curves[$#curves], $id);
if ( defined $options{xlen} &&
@{$options{histogram}} &&
@curves > @{$options{histogram}} ) {
print STDERR "--xlen only makes sense when plotting ONLY histograms or ONLY NON-histograms\n";
exit -1;
}
}
return $curves[$curveIndices{$id}];
}
sub addCurveOption
{
my ($id, $str) = @_;
my $curve = getCurve($id);
$curve->{extraoptions} .= "$str ";
updateCurveOptions($curve, $id);
}
sub setCurveLabel
{
my ($id, $str) = @_;
my $curve = getCurve($id);
$curve->{title} = $str;
updateCurveOptions($curve, $id);
}
sub setCurveAsHistogram
{
my ($id, $str) = @_;
my $curve = getCurve($id);
$curve->{histoptions} = 'using (histbin($2)):(1.0) smooth ' . $options{histstyle};
updateCurveOptions($curve, $id);
}
sub clearCurves
{
foreach my $curve(@curves)
{
$curve->{datastring} = '';
$curve->{datastring_meta} = [];
$curve->{datastring_offset} = 0;
}
}
sub replot
{
return unless $haveNewData;
$haveNewData = undef;
return if !$options{stream};
my ($domain0_numeric) = @_;
my $now = [gettimeofday];
if( $options{stream} < 0 ||
!$this_replot_is_from_timer && $last_replot_is_from_timer ||
tv_interval ( $last_replot_time, $now ) > 0.8*$options{stream} )
{
if ( defined $options{xlen} )
{
pruneOldData( $domain0_numeric - $options{xlen} );
my ($xmin, $xmax) = ($domain0_numeric - $options{xlen}, $domain0_numeric);
if ( defined $options{timefmt} )
{
($xmin, $xmax) = map {Time::Piece->strptime( $_, '%s' )->strftime( $options{timefmt} ) } ($xmin, $xmax);
}
sendRangeCommand( "xrange", $xmin, $xmax )
unless @{$options{histogram}};
}
plotStoredData();
$last_replot_time = $now;
$last_replot_is_from_timer = $this_replot_is_from_timer;
}
}
sub pushPoint
{
my ($curve, $datastring, $domain0_numeric) = @_;
push @{$curve->{datastring_meta}}, { offset_start => length( $curve->{datastring} ) + $curve->{datastring_offset},
domain => $domain0_numeric };
$curve->{datastring} .= $datastring;
$haveNewData = 1;
}
mainThread();