Compare commits

..

11 Commits

3 changed files with 136 additions and 41 deletions

16
Changes
View File

@@ -1,3 +1,19 @@
feedgnuplot (1.34)
* Fix for "Use of implicit split to @_ is deprecated". Thanks to Corey
Putkunz
* Declaring feedgnuplot as a package to let MetaCPAN index this
distribution
-- Dima Kogan <dima@secretsauce.net> Wed, 14 May 2014 00:45:24 -0700
feedgnuplot (1.33)
* fixed incorrect plotting of --timefmt --rangesize plots
-- Dima Kogan <dima@secretsauce.net> Thu, 06 Feb 2014 23:17:21 -0800
feedgnuplot (1.32) feedgnuplot (1.32)
* Added --rangesize and --rangesizeall. Different curves can now plot * Added --rangesize and --rangesizeall. Different curves can now plot

View File

@@ -1,4 +1,7 @@
#!/usr/bin/perl #!/usr/bin/perl
package feedgnuplot; # for the metacpan indexer
use strict; use strict;
use warnings; use warnings;
use Getopt::Long; use Getopt::Long;
@@ -11,9 +14,9 @@ use threads;
use threads::shared; use threads::shared;
use Thread::Queue; use Thread::Queue;
use Pod::Usage; use Pod::Usage;
use Time::Piece; use DateTime::Format::Strptime;
my $VERSION = 1.32; my $VERSION = 1.34;
my %options; my %options;
interpretCommandline(); interpretCommandline();
@@ -28,6 +31,9 @@ interpretCommandline();
# datastring # datastring
my $strptime;
my @curves = (); my @curves = ();
# list mapping curve names to their indices in the @curves list # list mapping curve names to their indices in the @curves list
@@ -72,6 +78,7 @@ if($options{stream})
} }
$streamingFinished = 1; $streamingFinished = 1;
$dataQueue->enqueue(undef);
$plotThr->join() if defined $plotThr; $plotThr->join() if defined $plotThr;
$addThr->join(); $addThr->join();
@@ -202,6 +209,23 @@ sub interpretCommandline
exit -1; exit -1;
} }
# I now set up the rangesize to always be
# $options{rangesize_hash}{$id} // $options{rangesize_default}
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} );
}
# parse stream option. Allowed only numbers >= 0 or 'trigger'. After this code # parse stream option. Allowed only numbers >= 0 or 'trigger'. After this code
# $options{stream} is # $options{stream} is
# -1 for triggered replotting # -1 for triggered replotting
@@ -354,19 +378,23 @@ sub interpretCommandline
$options{timefmt} =~ s/^\s*//; $options{timefmt} =~ s/^\s*//;
$options{timefmt} =~ s/\s*$//; $options{timefmt} =~ s/\s*$//;
my $Nfields = scalar split( ' ', $options{timefmt}); my $Nfields = () = split /\s+/, $options{timefmt}, -1;
$options{timefmt_Ncols} = $Nfields; $options{timefmt_Ncols} = $Nfields;
# make sure --xlen is an integer. With a timefmt xlen goes through strptime # make sure --xlen is an integer. With a timefmt xlen goes through strptime
# and strftime, and those are integer-only # and strftime, and those are integer-only
if( defined $options{xlen} ) if( defined $options{xlen} )
{ {
# warning do I need to make sure this is an integer anymore?
if( $options{xlen} - int($options{xlen}) ) if( $options{xlen} - int($options{xlen}) )
{ {
say STDERR "When streaming --xlen MUST be an integer. Rounding up to the nearest second"; print STDERR "When streaming --xlen MUST be an integer. Rounding up to the nearest second\n";
$options{xlen} = 1 + int($options{xlen}); $options{xlen} = 1 + int($options{xlen});
} }
} }
# $strptime = DateTime::Format::Strptime->new( pattern => $options{timefmt} );
} }
} }
@@ -393,8 +421,6 @@ sub plotUpdateThread
# indicate that the timer was the replot source # indicate that the timer was the replot source
$dataQueue->enqueue('replot timertick'); $dataQueue->enqueue('replot timertick');
} }
$dataQueue->enqueue(undef);
} }
sub sendRangeCommand sub sendRangeCommand
@@ -421,32 +447,23 @@ sub makeDomainNumeric
{ {
my ($domain0) = @_; 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();
if( $options{timefmt})
{
# my $t = $strptime->parse_datetime($domain0);
# print STDERR "$domain0 $t\n";
} }
# return $strptime->parse_datetime($domain0) if $options{timefmt};
return $domain0; return $domain0;
} }
sub mainThread sub mainThread
{ {
my $valuesPerPoint;
if( $options{rangesizeall} )
{
$valuesPerPoint = $options{rangesizeall};
}
else
{
$valuesPerPoint = 1;
if($options{extraValuesPerPoint}) { $valuesPerPoint += $options{extraValuesPerPoint}; }
if($options{colormap}) { $valuesPerPoint++; }
if($options{circles} ) { $valuesPerPoint++; }
}
local *PIPE; local *PIPE;
my $dopersist = ''; my $dopersist = '';
@@ -686,6 +703,17 @@ sub mainThread
@domain = splice(@fields, 0, 2); @domain = splice(@fields, 0, 2);
} }
# domain0_numeric is only used for xlen and monotonic, I think. And
# this is the only thing that requires strptime. Shouldn't bother with
# strptime otherwise
if( $options{monotonic} ) if( $options{monotonic} )
{ {
if( defined $latestX && $domain0_numeric < $latestX ) if( defined $latestX && $domain0_numeric < $latestX )
@@ -720,8 +748,6 @@ sub mainThread
while(@fields) while(@fields)
{ {
my $rangesize = $valuesPerPoint;
if($options{dataid}) if($options{dataid})
{ {
$id = shift @fields; $id = shift @fields;
@@ -731,10 +757,10 @@ sub mainThread
$id++; $id++;
} }
if( $options{rangesize_hash}{$id} ) # I'd like to use //, but I guess some people are still on perl 5.8
{ my $rangesize = exists $options{rangesize_hash}{$id} ?
$rangesize = $options{rangesize_hash}{$id}; $options{rangesize_hash}{$id} :
} $options{rangesize_default};
last if @fields < $rangesize; last if @fields < $rangesize;
@@ -747,14 +773,8 @@ sub mainThread
} }
} }
# if we were streaming, we're now done!
if( $options{stream} )
{
return;
}
# finished reading in all. Plot what we have # finished reading in all. Plot what we have
plotStoredData(); plotStoredData() unless $options{stream};
if ( defined $options{hardcopy}) if ( defined $options{hardcopy})
{ {
@@ -763,7 +783,7 @@ sub mainThread
# sleep until the plot file exists, and it is closed. Sometimes the output # sleep until the plot file exists, and it is closed. Sometimes the output
# is still being written at this point. If the output filename starts with # is still being written at this point. If the output filename starts with
# '|', gnuplot pipes the output to that process, instead of writing to a # '|', gnuplot pipes the output to that process, instead of writing to a
# file. In that case I don't make sure the file exists, since there IS not # file. In that case I don't make sure the file exists, since there IS no
# file # file
if( $options{hardcopy} !~ /^\|/ ) if( $options{hardcopy} !~ /^\|/ )
{ {
@@ -865,7 +885,19 @@ sub updateCurveOptions
my $usingoptions = ''; my $usingoptions = '';
if( $options{timefmt} ) if( $options{timefmt} )
{ {
$usingoptions = "using 1:" . ($options{timefmt_Ncols}+1); # with --timefmt I need an explicit 'using' specification. I specify the
# columns as 1:2:3..... I need the right number of columns (this is given
# as 1 + rangesize). I also need to start the range at the first column
# past the timefmt
# I'd like to use //, but I guess some people are still on perl 5.8
my $rangesize = exists $options{rangesize_hash}{$id} ?
$options{rangesize_hash}{$id} :
$options{rangesize_default};
my @rest = map {$_ + $options{timefmt_Ncols}} (1..$rangesize);
$usingoptions = "using 1:" . join(':', @rest);
} }
$curve->{options} = "$histoptions $usingoptions $titleoption $curve->{extraoptions} $curvestyleall"; $curve->{options} = "$histoptions $usingoptions $titleoption $curve->{extraoptions} $curvestyleall";
@@ -986,7 +1018,7 @@ sub replot
{ {
# if we're using a timefmt, I need to convert my xmin range from # if we're using a timefmt, I need to convert my xmin range from
# seconds-since-the-epoch BACK to the timefmt. Sheesh # seconds-since-the-epoch BACK to the timefmt. Sheesh
($xmin, $xmax) = map {Time::Piece->strptime( $_, '%s' )->strftime( $options{timefmt} ) } ($xmin, $xmax); ($xmin, $xmax) = map {$strptime->parse_datetime($_)} ($xmin, $xmax);
} }
sendRangeCommand( "xrange", $xmin, $xmax ); sendRangeCommand( "xrange", $xmin, $xmax );
} }

View File

@@ -39,7 +39,7 @@ BEGIN {
} }
} }
use Test::More tests => 56; use Test::More tests => 58;
use File::Temp 'tempfile'; use File::Temp 'tempfile';
use IPC::Run 'run'; use IPC::Run 'run';
use String::ShellQuote; use String::ShellQuote;
@@ -801,6 +801,53 @@ tryplot( testname => '--timefmt plot with --monotonic',
EOF EOF
tryplot( testname => '--timefmt with custom rangesize',
cmd => q{seq 5 | gawk '{print strftime("%d %b %Y %T",1382249107+$1,1),$1,$1/10}'},
options => ['--domain', '--timefmt', '%d %b %Y %H:%M:%S',
qw(--with errorbars --rangesizeall 2)],
refplot => <<'EOF' );
5.5 ++---------+-----------+----------+----------+----------+-----------+----------+---------**
+ + + + + + + + *
| *
5 ++ +A
| *
| *
| *
4.5 ++ **
| *** |
| * |
4 ++ A ++
| * |
| * |
| *** |
3.5 ++ ++
| *** |
| * |
3 ++ A ++
| * |
| * |
| *** |
2.5 ++ ++
| |
| *** |
2 ++ A ++
| * |
| *** |
| |
1.5 ++ ++
| |
| |
1 A* ++
** |
| |
+ + + + + + + + +
0.5 ++---------+-----------+----------+----------+----------+-----------+----------+---------++
05:08 05:08 05:09 05:09 05:10 05:10 05:11 05:11 05:12
EOF
tryplot( testname => 'Error bars (using extraValuesPerPoint)', tryplot( testname => 'Error bars (using extraValuesPerPoint)',
cmd => q{seq 5 | gawk '{print $1,$1,$1/10}'}, cmd => q{seq 5 | gawk '{print $1,$1,$1/10}'},
options => [qw(--domain), options => [qw(--domain),