Merge branch 'master' of /home/hjp/git-repos/timeseries
This commit is contained in:
commit
2ef9920fd9
|
@ -31,7 +31,7 @@ use Time::Local;
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use HTTP::Date qw(parse_date);
|
use HTTP::Date qw(parse_date);
|
||||||
use Time::Local qw(timegm_nocheck);
|
use Time::Local qw(timegm_nocheck);
|
||||||
use POSIX qw(strftime);
|
use POSIX qw(floor strftime);
|
||||||
|
|
||||||
our $VERSION = do { my @r=(q$Revision: 1.24 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
|
our $VERSION = do { my @r=(q$Revision: 1.24 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
|
||||||
|
|
||||||
|
@ -404,8 +404,10 @@ sub plot {
|
||||||
|
|
||||||
my @tics = get_ticks($firsttime, $lasttime);
|
my @tics = get_ticks($firsttime, $lasttime);
|
||||||
|
|
||||||
|
# force tick values to look like fp numbers to avoid warnings about
|
||||||
|
# exceeding the int range from gnuplot
|
||||||
print $ctlfh "set xtics rotate (",
|
print $ctlfh "set xtics rotate (",
|
||||||
join(", ", map sprintf(qq|"%s" %d|, $_->[1], $_->[0]), @tics),
|
join(", ", map sprintf(qq|"%s" %.16e|, $_->[1], $_->[0]), @tics),
|
||||||
")\n";
|
")\n";
|
||||||
|
|
||||||
# what to plot
|
# what to plot
|
||||||
|
@ -450,9 +452,10 @@ sub plot {
|
||||||
if ($self->{gsresolution} != $self->{finalresolution}) {
|
if ($self->{gsresolution} != $self->{finalresolution}) {
|
||||||
$pipe .= "pnmscale " . ($self->{finalresolution} / $self->{gsresolution}) . " |";
|
$pipe .= "pnmscale " . ($self->{finalresolution} / $self->{gsresolution}) . " |";
|
||||||
}
|
}
|
||||||
$pipe .=
|
$pipe .= "pnmflip -cw |";
|
||||||
"pnmflip -cw |" .
|
if ($self->{crop}) {
|
||||||
"pnmcrop 2> /dev/null |";
|
$pipe .= "pnmcrop 2> /dev/null |";
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if ($self->{output_format} eq "png") {
|
if ($self->{output_format} eq "png") {
|
||||||
|
@ -498,7 +501,32 @@ sub get_ticks {
|
||||||
my $label;
|
my $label;
|
||||||
my $nexttime;
|
my $nexttime;
|
||||||
|
|
||||||
if ($lasttime - $firsttime > 3 * 365 * 24 * 3600) {
|
if ($lasttime - $firsttime > 50 * 365 * 24 * 3600) {
|
||||||
|
# more than 50 years: 1 tick/5 years
|
||||||
|
|
||||||
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
$sec = $min = $hour = 0;
|
||||||
|
$mday = 1;
|
||||||
|
$mon = 0;
|
||||||
|
$year = floor($year / 5) * 5;
|
||||||
|
$firsttime = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
|
||||||
|
$label = '%Y-%m-%d';
|
||||||
|
|
||||||
|
$nexttime = sub { return add_years($_[0], 5) };
|
||||||
|
} elsif ($lasttime - $firsttime > 10 * 365 * 24 * 3600) {
|
||||||
|
# more than 10 years: 1 tick/year
|
||||||
|
|
||||||
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
$sec = $min = $hour = 0;
|
||||||
|
$mday = 1;
|
||||||
|
$mon = 0;
|
||||||
|
$firsttime = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
|
||||||
|
$label = '%Y-%m-%d';
|
||||||
|
|
||||||
|
$nexttime = sub { return add_years($_[0], 1) };
|
||||||
|
} elsif ($lasttime - $firsttime > 3 * 365 * 24 * 3600) {
|
||||||
# more than 3 years: 4 ticks/year
|
# more than 3 years: 4 ticks/year
|
||||||
|
|
||||||
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
|
||||||
|
@ -600,11 +628,21 @@ sub add_months {
|
||||||
my ($time, $d_mon) = @_;
|
my ($time, $d_mon) = @_;
|
||||||
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
|
||||||
= localtime($time);
|
= localtime($time);
|
||||||
|
$year += 1900; # localtime/timelocal mismatch
|
||||||
$mon += $d_mon;
|
$mon += $d_mon;
|
||||||
if ($mon >= 12) {
|
if ($mon >= 12) {
|
||||||
$mon -= 12; $year++;
|
$mon -= 12; $year++;
|
||||||
}
|
}
|
||||||
$time = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
$time = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
};
|
}
|
||||||
|
|
||||||
|
sub add_years {
|
||||||
|
my ($time, $d_year) = @_;
|
||||||
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
|
||||||
|
= localtime($time);
|
||||||
|
$year += 1900; # localtime/timelocal mismatch
|
||||||
|
$year += $d_year;
|
||||||
|
$time = timelocal($sec,$min,$hour,$mday,$mon,$year);
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
34
tsplotv
34
tsplotv
|
@ -13,6 +13,9 @@ tsplotv
|
||||||
[--output-format format ]
|
[--output-format format ]
|
||||||
[--stacked]
|
[--stacked]
|
||||||
[--style style]
|
[--style style]
|
||||||
|
[--time_t]
|
||||||
|
[--colors rgb-list]
|
||||||
|
[--configfile yaml]
|
||||||
[file ...]
|
[file ...]
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
=head1 DESCRIPTION
|
||||||
|
@ -40,6 +43,7 @@ use strict;
|
||||||
use TimeSeries;
|
use TimeSeries;
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
use Pod::Usage;
|
use Pod::Usage;
|
||||||
|
use YAML qw(LoadFile);
|
||||||
|
|
||||||
my $help;
|
my $help;
|
||||||
my $legend_position = 'top right';
|
my $legend_position = 'top right';
|
||||||
|
@ -50,6 +54,7 @@ my $log_y = 0;
|
||||||
my $finalresolution;
|
my $finalresolution;
|
||||||
my $time_t = 0;
|
my $time_t = 0;
|
||||||
my $colors;
|
my $colors;
|
||||||
|
my $configfile;
|
||||||
|
|
||||||
GetOptions('help|?' => \$help,
|
GetOptions('help|?' => \$help,
|
||||||
'legend_position|legend-position=s' => \$legend_position,
|
'legend_position|legend-position=s' => \$legend_position,
|
||||||
|
@ -60,33 +65,46 @@ GetOptions('help|?' => \$help,
|
||||||
'finalresolution' => \$finalresolution,
|
'finalresolution' => \$finalresolution,
|
||||||
'time_t' => \$time_t,
|
'time_t' => \$time_t,
|
||||||
'colors=s' => \$colors,
|
'colors=s' => \$colors,
|
||||||
|
'configfile=s' => \$configfile,
|
||||||
) or pod2usage(2);
|
) or pod2usage(2);
|
||||||
pod2usage(1) if $help;
|
pod2usage(1) if $help;
|
||||||
|
|
||||||
|
my $config = LoadFile($configfile) if $configfile;
|
||||||
|
|
||||||
binmode STDOUT, ':raw';
|
binmode STDOUT, ':raw';
|
||||||
|
|
||||||
my %series;
|
my $ns = 0;
|
||||||
my $ns;
|
|
||||||
my %data;
|
my %data;
|
||||||
|
|
||||||
my $ts = TimeSeries->new(output_format => $output_format);
|
$config->{timeseries} //= {};
|
||||||
|
for (keys $config->{timeseries}) {
|
||||||
|
$ns = $config->{timeseries}{$_}{order} if ($config->{timeseries}{$_}{order} // 0) > $ns;
|
||||||
|
}
|
||||||
|
|
||||||
while (<>) {
|
while (<>) {
|
||||||
chomp;
|
chomp;
|
||||||
my ($timestamp, $series, $value) = split(/\t/);
|
my ($timestamp, $series, $value) = split(/\t/);
|
||||||
$series{$series} = ++$ns unless ($series{$series});
|
$config->{timeseries}{$series}{order} = ++$ns unless ($config->{timeseries}{$series}{order});
|
||||||
$data{$timestamp}{$series} = $value;
|
$data{$timestamp}{$series} = $value;
|
||||||
}
|
}
|
||||||
my @series = sort { $series{$a} <=> $series{$b} } keys %series;
|
my @series = sort { $config->{timeseries}{$a}{order} <=> $config->{timeseries}{$b}{order} }
|
||||||
|
keys $config->{timeseries};
|
||||||
|
if ($colors) {
|
||||||
|
my @colors = split(/,/, $colors);
|
||||||
|
while (my ($i, $c) = each(@colors)) {
|
||||||
|
$config->{timeseries}{$series[$i]}{color} = $c;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
my $ts = TimeSeries->new(output_format => $output_format);
|
||||||
$ts->legend(@series);
|
$ts->legend(@series);
|
||||||
$ts->legend_position($legend_position);
|
$ts->legend_position($legend_position);
|
||||||
$ts->stacked($stacked);
|
$ts->stacked($stacked);
|
||||||
$ts->style($style);
|
$ts->style($style);
|
||||||
$ts->log_y($log_y);
|
$ts->log_y($log_y);
|
||||||
$ts->finalresolution($finalresolution) if $finalresolution;
|
$ts->finalresolution($finalresolution) if $finalresolution;
|
||||||
if ($colors) {
|
$ts->colors(map $config->{timeseries}{$_}{color}, @series);
|
||||||
$ts->colors(split(/,/, $colors));
|
|
||||||
}
|
|
||||||
|
|
||||||
for my $timestamp (sort keys %data) {
|
for my $timestamp (sort keys %data) {
|
||||||
my %d = %{$data{$timestamp}};
|
my %d = %{$data{$timestamp}};
|
||||||
|
|
Loading…
Reference in New Issue