Snapshot
This commit is contained in:
commit
05c38f1efa
|
@ -0,0 +1,13 @@
|
||||||
|
use ExtUtils::MakeMaker;
|
||||||
|
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||||
|
# the contents of the Makefile that is written.
|
||||||
|
WriteMakefile(
|
||||||
|
'NAME' => 'TimeSeries',
|
||||||
|
'VERSION_FROM' => 'TimeSeries.pm', # finds $VERSION
|
||||||
|
'PREREQ_PM' => {
|
||||||
|
'File::Temp' => 0,
|
||||||
|
'Time::Local' => 0,
|
||||||
|
'Data::Dumper' => 0,
|
||||||
|
},
|
||||||
|
'EXE_FILES' => [ ],
|
||||||
|
);
|
|
@ -0,0 +1,221 @@
|
||||||
|
package TimeSeries;
|
||||||
|
|
||||||
|
use File::Temp qw(tempfile);
|
||||||
|
use Time::Local;
|
||||||
|
use Data::Dumper;
|
||||||
|
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my ($class, %opts) = @_;
|
||||||
|
my $self = {};
|
||||||
|
bless ($self, $class);
|
||||||
|
|
||||||
|
$self->{data} = [];
|
||||||
|
$self->{style} = "lines";
|
||||||
|
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub add {
|
||||||
|
my ($self, $timestamp, @data) = @_;
|
||||||
|
|
||||||
|
push(@{$self->{data}}, [ $timestamp, [ @data ] ]);
|
||||||
|
#print Dumper($self);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub legend {
|
||||||
|
my ($self, @legend) = @_;
|
||||||
|
my $oldlegend = $self->{legend};
|
||||||
|
$self->{legend} = [@legend] if (@legend);
|
||||||
|
return @$oldlegend;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub style {
|
||||||
|
my ($self, $style) = @_;
|
||||||
|
my $oldstyle = $self->{style};
|
||||||
|
$self->{style} = $style if ($style);
|
||||||
|
return $oldstyle;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
sub dstcorr {
|
||||||
|
my ($time) = @_;
|
||||||
|
|
||||||
|
($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
|
||||||
|
my $toff = $hour * 3600 + $min * 60 * $sec;
|
||||||
|
if ($toff != 0) {
|
||||||
|
if ($toff > 12*3600) {
|
||||||
|
$toff -= 24 * 3600;
|
||||||
|
}
|
||||||
|
print STDERR "correcting time by $toff seconds ";
|
||||||
|
printf STDERR "from %04d-%02d-%02d %02d:%02d:%02d ", $year+1900, $mon+1, $mday, $hour, $min, $sec;
|
||||||
|
$time -= $toff;
|
||||||
|
($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
|
||||||
|
printf STDERR "to %04d-%02d-%02d %02d:%02d:%02d\n", $year+1900, $mon+1, $mday, $hour, $min, $sec;
|
||||||
|
}
|
||||||
|
return $time;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub plot {
|
||||||
|
my ($self) = @_;
|
||||||
|
#print Dumper($self);
|
||||||
|
|
||||||
|
my ($datafh, $datafn) = tempfile();
|
||||||
|
for my $i (@{$self->{data}}) {
|
||||||
|
my $time = $i->[0];
|
||||||
|
my $data = $i->[1];
|
||||||
|
|
||||||
|
print $datafh $time;
|
||||||
|
for my $j (@$data) {
|
||||||
|
print $datafh "\t", $j + 0;
|
||||||
|
}
|
||||||
|
print $datafh "\n";
|
||||||
|
}
|
||||||
|
close($datafh);
|
||||||
|
|
||||||
|
my ($ctlfh, $ctlfn) = tempfile();
|
||||||
|
my ($psfh, $psfn) = tempfile();
|
||||||
|
|
||||||
|
# generic settings
|
||||||
|
|
||||||
|
print $ctlfh "set term postscript color\n";
|
||||||
|
print $ctlfh "set output '$psfn'\n";
|
||||||
|
print $ctlfh "set data style $self->{style}\n";
|
||||||
|
print $ctlfh "set grid\n";
|
||||||
|
|
||||||
|
# compute ticks
|
||||||
|
|
||||||
|
my $firsttime = $self->{data}[0][0];
|
||||||
|
my $lasttime = $self->{data}[$#{$self->{data}}][0];
|
||||||
|
|
||||||
|
if ($lasttime - $firsttime > 3 * 30 * 24 * 3600) {
|
||||||
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
$sec = $min = $hour = 0;
|
||||||
|
$mday = 1;
|
||||||
|
$firsttime = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
print $ctlfh "set xtics rotate (";
|
||||||
|
my $comma = 0;
|
||||||
|
my $time;
|
||||||
|
for (;;) {
|
||||||
|
$time = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
if ($comma) {
|
||||||
|
print $ctlfh ", ";
|
||||||
|
} else {
|
||||||
|
$comma = 1;
|
||||||
|
}
|
||||||
|
printf $ctlfh qq|"%04d-%02d-%02d" %d|, $year+1900, $mon+1, $mday, $time;
|
||||||
|
if (++$mon >= 12) {
|
||||||
|
$mon = 0; $year++;
|
||||||
|
}
|
||||||
|
if ($time > $lasttime) {last}
|
||||||
|
}
|
||||||
|
$lasttime = $time;
|
||||||
|
print $ctlfh ")\n";
|
||||||
|
} elsif ($lasttime - $firsttime > 30 * 24 * 3600) {
|
||||||
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
$firsttime -= 86400 * $wday;
|
||||||
|
|
||||||
|
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
$sec = $min = $hour = 0;
|
||||||
|
my $time = $firsttime = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
print $ctlfh "set xtics rotate (";
|
||||||
|
my $comma = 0;
|
||||||
|
for (;;) {
|
||||||
|
($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
|
||||||
|
if ($comma) {
|
||||||
|
print $ctlfh ", ";
|
||||||
|
} else {
|
||||||
|
$comma = 1;
|
||||||
|
}
|
||||||
|
printf $ctlfh qq|"%04d-%02d-%02d" %d|, $year+1900, $mon+1, $mday, $time;
|
||||||
|
if ($time > $lasttime) {last}
|
||||||
|
|
||||||
|
$time += 7 * 24 * 3600;
|
||||||
|
$time = dstcorr($time);
|
||||||
|
}
|
||||||
|
$lasttime = $time;
|
||||||
|
print $ctlfh ")\n";
|
||||||
|
} elsif ($lasttime - $firsttime > 3 * 24 * 3600) {
|
||||||
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
$sec = $min = $hour = 0;
|
||||||
|
my $time = $firsttime = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
print $ctlfh "set xtics rotate (";
|
||||||
|
my $comma = 0;
|
||||||
|
for (;;) {
|
||||||
|
($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
|
||||||
|
if ($comma) {
|
||||||
|
print $ctlfh ", ";
|
||||||
|
} else {
|
||||||
|
$comma = 1;
|
||||||
|
}
|
||||||
|
printf $ctlfh qq|"%04d-%02d-%02d" %d|, $year+1900, $mon+1, $mday, $time;
|
||||||
|
if ($time > $lasttime) {last}
|
||||||
|
|
||||||
|
$time += 24 * 3600;
|
||||||
|
$time = dstcorr($time);
|
||||||
|
}
|
||||||
|
$lasttime = $time;
|
||||||
|
print $ctlfh ")\n";
|
||||||
|
} else {
|
||||||
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
$sec = $min = 0;
|
||||||
|
my $time = $firsttime = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
print $ctlfh "set xtics rotate (";
|
||||||
|
my $comma = 0;
|
||||||
|
for (;;) {
|
||||||
|
($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
|
||||||
|
if ($comma) {
|
||||||
|
print $ctlfh ", ";
|
||||||
|
} else {
|
||||||
|
$comma = 1;
|
||||||
|
}
|
||||||
|
printf $ctlfh qq|"%04d-%02d-%02d %02d:%02d" %d|, $year+1900, $mon+1, $mday, $hour, $min, $time;
|
||||||
|
if ($time > $lasttime) {last}
|
||||||
|
|
||||||
|
$time += 3600;
|
||||||
|
}
|
||||||
|
$lasttime = $time;
|
||||||
|
print $ctlfh ")\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
# what to plot
|
||||||
|
|
||||||
|
print $ctlfh "plot ";
|
||||||
|
$comma = 0;
|
||||||
|
$col = 2;
|
||||||
|
|
||||||
|
for $i (@{$self->{legend}}) {
|
||||||
|
if ($comma) {
|
||||||
|
print $ctlfh ", ";
|
||||||
|
} else {
|
||||||
|
$comma = 1;
|
||||||
|
}
|
||||||
|
print $ctlfh "'$datafn' using 1:", $col++, " title '$i'";
|
||||||
|
}
|
||||||
|
|
||||||
|
print $ctlfh "\n";
|
||||||
|
|
||||||
|
close ($ctlfh);
|
||||||
|
|
||||||
|
|
||||||
|
my $rc = system("gnuplot", $ctlfn);
|
||||||
|
print STDERR "system returned $rc\n";
|
||||||
|
|
||||||
|
open(PNG, "gs -sDEVICE=ppmraw -r150 -dBATCH -sOutputFile=- -q - < $psfn |" .
|
||||||
|
"pnmscale 0.5 |" .
|
||||||
|
"pnmflip -cw |" .
|
||||||
|
"pnmcrop |" .
|
||||||
|
"ppmquant 256 |" .
|
||||||
|
"ppmtogif |");
|
||||||
|
|
||||||
|
my $png;
|
||||||
|
{ local $/ = undef; $png = <PNG>; }
|
||||||
|
close(PNG);
|
||||||
|
return $png;
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
Loading…
Reference in New Issue