timeseries/TimeSeries.pm

package TimeSeries;

use File::Temp qw(tempfile);
use Time::Local;
use Data::Dumper;
use HTTP::Date qw(parse_date);
use Time::Local qw(timegm_nocheck);

$VERSION = do { my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};

sub new {
    my ($class, %opts) = @_;
    my $self = {};
    bless ($self, $class);

    $self->{data} = [];
    $self->{style} = "lines";
    $self->{output_format} = "png";

    return $self;
}


sub add {
    my ($self, $timestamp, @data) = @_;

    push(@{$self->{data}}, [ $timestamp, [ @data ] ]);
    #print Dumper($self);
}

sub add_timestring {
    my ($self, $timestring, @data) = @_;

    my ($year, $mon, $day, $hour, $min, $sec, $zone) 
	= parse_date($timestring);

    # print STDERR "date = ($year, $mon, $day, $hour, $min, $sec, $zone)\n";

    my $timestamp;
    if (defined ($zone)) {
	# adjust for timezone
	my ($zs, $zh, $zm) = $zone =~ /([+-])(\d\d)(\d\d)/;
	$min -= ($zs eq '-' ? -1 : +1) * ($zh * 60 + $zm);
	$timestamp = timegm_nocheck($sec, $min, $hour, $day, $mon-1, $year);
    } else {
	$timestamp = timelocal($sec, $min, $hour, $day, $mon-1, $year);
    }
    # print STDERR "\$timestamp = $timestamp\n";
    $self->add($timestamp, @data);
}


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 log_x {
    my ($self, $log_x) = @_;
    my $oldlog_x = $self->{log_x};
    $self->{log_x} = $log_x if ($log_x);
    return $oldlog_x;
}

sub log_y {
    my ($self, $log_y) = @_;
    my $oldlog_y = $self->{log_y};
    $self->{log_y} = $log_y if ($log_y);
    return $oldlog_y;
}

sub output_format {
    my ($self, $output_format) = @_;
    my $oldoutput_format = $self->{output_format};
    $self->{output_format} = $output_format if ($output_format);
    return $oldoutput_format;
}



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";
    print $ctlfh "set log x\n" if ($self->{log_x});
    print $ctlfh "set log y\n" if ($self->{log_y});

    # compute ticks

    my $firsttime = $self->{data}[0][0];
    my $lasttime = $self->{data}[$#{$self->{data}}][0];

    if ($lasttime - $firsttime > 3 * 365 * 24 * 3600) {
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($firsttime);
	$sec = $min = $hour = 0;
	$mday = 1;
	$mon = int($mon/3) * 3;
	$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;
	    $mon += 3;
	    if ($mon >= 12) {
		$mon -= 12; $year++;
	    }
	    if ($time > $lasttime) {last}
	}
	$lasttime = $time;
	print $ctlfh ")\n";
    } elsif ($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";

    my $pipe;

    if ($self->{output_format} eq "ps") {
	$pipe = "< $psfn";
    } else {
	$pipe = 
	    "gs -sDEVICE=ppmraw -r150 -dBATCH -sOutputFile=- -q - < $psfn |" .
	    "pnmscale 0.5 |" .
	    "pnmflip -cw |" .
	    "pnmcrop 2> /dev/null |";
    }

    if ($self->{output_format} eq "png") {
	$pipe .= "pnmtopng |";
    }
    if ($self->{output_format} eq "gif") {
	# the ppm tools are noisy. Shut them up.
	$pipe .= "ppmquant 256 2> /dev/null |" .
	   "ppmtogif 2> /dev/null |";
    }
    if ($self->{output_format} eq "jpeg") {
	$pipe .= "cjpeg -sample 1x1,1x1,1x1 |";
    }
    open(PNG, $pipe);

    my $graph;
    { local $/ = undef; $graph = <PNG>; }
    close(PNG);
    return $graph;
}

1;