This is an automated email from the git hooks/post-receive script.
dom pushed a commit to branch master
in repository libchart-strip-perl.git.
commit 6b7e4d8f460d61d230e64d72f07ce75503bff9c7
Author: Dominic Hargreaves <d...@earth.li>
Date: Tue Feb 26 21:47:20 2008 +0000
[svn-upgrade] Integrating new upstream version, libchart-strip-perl (1.05)
---
CHANGES | 3 +
MANIFEST | 1 +
META.yml | 2 +-
Strip.pm | 398 +++++++++++++++++++++++++++++++++++++++------------------
t/test3.t | 433 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 713 insertions(+), 124 deletions(-)
diff --git a/CHANGES b/CHANGES
index 0a5e6f5..5f6f52f 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,4 +1,7 @@
+1.05
+ xtic changes and speedups
+
1.04
added missing files to MANIFEST
diff --git a/MANIFEST b/MANIFEST
index 3f66eb7..6641e60 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -6,6 +6,7 @@ Makefile.PL
Strip.pm
t/test1.t
t/test2.t
+t/test3.t
eg/index.html
eg/Makefile
eg/ex1.pl
diff --git a/META.yml b/META.yml
index c450404..53e3946 100644
--- a/META.yml
+++ b/META.yml
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Chart-Strip
-version: 1.04
+version: 1.05
version_from: Strip.pm
installdirs: site
requires:
diff --git a/Strip.pm b/Strip.pm
index e1db111..69f396f 100644
--- a/Strip.pm
+++ b/Strip.pm
@@ -5,9 +5,9 @@
# Date: 2002-Nov-01 16:11 (EST)
# Function: draw strip charts
#
-# $Id: Strip.pm,v 1.14 2006/05/27 18:20:39 jaw Exp jaw $
+# $Id: Strip.pm,v 1.15 2006/06/25 17:48:59 jaw Exp jaw $
-$Chart::Strip::VERSION = "1.04";
+$Chart::Strip::VERSION = "1.05";
=head1 NAME
@@ -185,6 +185,20 @@ use Carp;
use POSIX;
use strict;
+my $LT_HM = 1; # time
+my $LT_HR = 2; # time/day
+my $LT_DW = 3; # day/date
+my $LT_DM = 4; # date/yr
+my $LT_YR = 5; # year
+
+my $MT_NO = 0; # none
+my $MT_HR = 1; # hrs
+my $MT_MN = 2; # midnight
+my $MT_SU = 3; # sunday
+my $MT_M1 = 4; # 1st
+my $MT_Y1 = 5; # new years
+
+
sub new {
my $class = shift;
my %param = @_;
@@ -239,11 +253,11 @@ sub new {
$im->setStyle(gdTransparent, $me->{color}{gray}, gdTransparent,
gdTransparent);
$im->interlaced('true');
- $me->{img}->transparent($me->{color}{white})
+ $im->transparent($me->{color}{white})
if $me->{transparent};
- $me->{img}->rectangle(0, 0, $me->{width}-1, $me->{height}-1,
- $me->color({ color => ($me->{border_color} || 'black') }))
+ $im->rectangle(0, 0, $me->{width}-1, $me->{height}-1,
+ $me->color({ color => ($me->{border_color} || 'black') }))
if $me->{draw_border};
$me;
@@ -552,7 +566,7 @@ sub pretty {
}
elsif( $ay < 1/$b**2 ){
$y *= $b ** 3; $st *= $b ** 3;
- $sc = 'p';
+ $sc = 'n';
}
elsif( $ay < 1/$b ){
$y *= $b**2; $st *= $b**2;
@@ -563,7 +577,11 @@ sub pretty {
$sc = 'm';
}
}else{
- if( $ay >= $b**3 ){
+ if( $ay >= $b**4 ){
+ $y /= $b**4; $st /= $b**4;
+ $sc = 'T';
+ }
+ elsif( $ay >= $b**3 ){
$y /= $b**3; $st /= $b**3;
$sc = 'G';
}
@@ -628,24 +646,25 @@ sub ytics {
$me->adjust();
}
- $me->{grid}{y} = [ @tics ];
+ $me->{grid}{y} = \@tics;
}
sub drawgrid {
my $me = shift;
+ my $im = $me->{img};
foreach my $tic (@{$me->{grid}{y}}){
# ytics + horiz lines
my $yy = $tic->[0];
- $me->{img}->line($me->xpt(-1), $yy, $me->xpt(-4), $yy,
+ $im->line($me->xpt(-1), $yy, $me->xpt(-4), $yy,
$me->{color}{black});
- $me->{img}->line($me->xpt(0), $yy, $me->{width} - $me->{margin_right},
$yy,
+ $im->line($me->xpt(0), $yy, $me->{width} - $me->{margin_right}, $yy,
gdStyled) if $me->{draw_grid};
if( $me->{draw_tic_labels} ){
my $label = $tic->[1];
my $w = $tic->[2];
- $me->{img}->string(gdTinyFont, $me->xpt(-$w), $yy-4,
+ $im->string(gdTinyFont, $me->xpt(-$w), $yy-4,
$label,
$me->{color}{black});
}
@@ -655,17 +674,18 @@ sub drawgrid {
# xtics + vert lines
my( $t, $ll, $label ) = @$tic;
- if( $ll ){
+ # supress solid line if adjacent to axis
+ if( $ll && ($t != $me->{xd_min}) ){
# solid line, red label
- $me->{img}->line($me->xdatapt($t), $me->{margin_top},
+ $im->line($me->xdatapt($t), $me->{margin_top},
$me->xdatapt($t), $me->ypt(-4),
$me->{color}{black} );
}else{
# tic and grid
- $me->{img}->line($me->xdatapt($t), $me->ypt(-1),
+ $im->line($me->xdatapt($t), $me->ypt(-1),
$me->xdatapt($t), $me->ypt(-4),
$me->{color}{black} );
- $me->{img}->line($me->xdatapt($t), $me->{margin_top},
+ $im->line($me->xdatapt($t), $me->{margin_top},
$me->xdatapt($t), $me->ypt(0),
gdStyled ) if $me->{draw_grid};
}
@@ -677,88 +697,206 @@ sub drawgrid {
$a = $me->xdatapt($t) - $me->{width} + length($label) * 6 + 2;
}
- $me->{img}->string(gdSmallFont, $me->xdatapt($t)-$a, $me->ypt(-6),
+ $im->string(gdSmallFont, $me->xdatapt($t)-$a, $me->ypt(-6),
$label, $ll ? $me->{color}{red} :
$me->{color}{black} );
}
}
}
-# this is much too ickky, please re-write
+sub xtic_range_data {
+ my $me = shift; # not used
+ my $range = shift;
+
+ my $range_hrs = $range / 3600;
+ my $range_days = $range_hrs / 24;
+
+ # return: step, labeltype, marktype, lti, tmod
+
+ if( $range < 720 ){
+ (60, $LT_HM, $MT_HR, 1, 1); # tics: 1 min
+ }
+ elsif( $range < 1800 ){
+ (300, $LT_HM, $MT_HR, 1, 5); # tics: 5 min
+ }
+ elsif( $range_hrs < 2 ){
+ (600, $LT_HM, $MT_HR, 1, 10); # tics: 10 min
+ }
+ elsif( $range_hrs < 6 ){
+ (1800, $LT_HR, $MT_MN, 1, 30); # tics: 30 min
+ }
+ elsif( $range_hrs < 13 ){
+ (3600, $LT_HR, $MT_MN, 2, 1); # tics: 1 hr
+ }
+ elsif( $range_hrs < 25 ){
+ (3600, $LT_HR, $MT_MN, 2, 2); # tics: 2 hrs
+ }
+ elsif( $range_hrs < 50 ){
+ (3600, $LT_HR, $MT_MN, 2, 4); # tics: 4 hrs
+ }
+ elsif( $range_hrs < 75 ){
+ (3600, $LT_HR, $MT_MN, 2, 6); # tics: 6 hrs
+ }
+
+ # NB: days shorter or longer than 24 hours are corrected for below
+ elsif( $range_days < 15 ){
+ (3600*24, $LT_DW, $MT_SU, 3, 1); # tics 1 day
+ }
+ elsif( $range_days < 22 ){
+ (3600*24, $LT_DM, $MT_M1, 3, 2); # tics: 2 days
+ }
+ elsif( $range_days < 80 ){
+ (3600*24, $LT_DM, $MT_M1, 3, 7); # tics: 7 days
+ }
+ elsif( $range_days < 168 ){
+ (3600*24, $LT_DM, $MT_Y1, 3, 14); # tics: 14 days
+ }
+ # NB: months shorter than 31 days are corrected for below
+ elsif( $range_days < 370 ){
+ (3600*24*31, $LT_DM, $MT_Y1, 4, 1); # tics: 1 month
+ }
+ elsif( $range_days < 500 ){
+ (3600*24*31, $LT_DM, $MT_Y1, 4, 2); # tics: 2 month
+ }
+ elsif( $range_days < 1000 ){
+ (3600*24*31, $LT_DM, $MT_Y1, 4, 3); # tics: 3 month
+ }
+ elsif( $range_days < 2000 ){
+ (3600*24*31, $LT_DM, $MT_NO, 4, 6); # tics: 6 month
+ }
+
+ else{
+ # NB: years less than 366 days are corrected for below
+ (3600*24*366, $LT_YR, $MT_NO, 4, 12); # tics: 1 yr
+ }
+}
+
+sub xtic_align_initial {
+ my $me = shift;
+ my $step = shift;
+
+ my $t = ($step < 3600) ? (int($me->{xd_min} / $step) * $step)
+ : (int($me->{xd_min} / 3600) * 3600);
+
+ if( $step >= 3600*24*365 ){
+ while(1){
+ # search for 1jan
+ my @lt = localtime $t;
+ last if $lt[4] == 0 && $lt[3] == 1 && $lt[2] == 0;
+ # jump fwd: 1M, 1D, or 1H
+ my $dt = ($lt[4] != 11) ? 24*30 : ($lt[3] < 30) ? 24 : 1;
+ $t += $dt * 3600;
+ }
+ }
+ elsif( $step >= 3600*24*31 ){
+ while(1){
+ # find 1st of mon
+ my @lt = localtime $t;
+ last if $lt[3] == 1 && $lt[2] == 0;
+ my $dt = ($lt[3] < 28) ? 24 : 1;
+ $t += $dt * 3600;
+ }
+ }
+ elsif( $step >= 3600*24 ){
+ while(1){
+ # search for midnight
+ my @lt = localtime $t;
+ last unless $lt[2];
+ $t += 3600;
+ }
+ }
+
+ $t;
+}
+
sub xtics {
my $me = shift;
- my( $r, $step, $rd, $n2, $n3, $n4, $lt, $low, $t, @tics );
+ my @tics;
# this is good for (roughly) 10 mins - 10 yrs
return if $me->{xd_max} == $me->{xd_min};
- $r = ($me->{xd_max} - $me->{xd_min} ) / 3600; # => hours
- $rd = $r / 24; # days
- $step = 3600;
- $n2 = 24; $n3 = $n4 = 1;
- $low = int($me->{xd_min} / 3600) * 3600;
+
+ my $range = $me->{xd_max} - $me->{xd_min};
+ my $range_hrs = $range / 3600;
+ my $range_days = $range_hrs / 24;
- if( $r < 2 ){ # less than 2 hrs
- $low = int($me->{xd_min} / 600) * 600;
- $n2 = 1;
- $lt = 1;
- $step = 10 * 60;
- }elsif( $r < 48 ){ # less than 2 days
- $n2 = ($r < 13) ? 1 : ($r < 24) ? 2 : 4;
- $lt = 1;
- }
- elsif( $r < 360 ){ # less than ~ 2 weeks
- $lt = 2;
- }elsif( $rd < 1500 ){ # less than ~ 4yrs
- $n3 = ($rd < 80) ? 7 : ($rd < 168) ? 14 : 32;
- $n4 = ($rd < 370) ? 1 : ($rd < 500) ? 2 : 4;
- $lt = 3;
- }else{
- $n3 = 32; $n4 = 12;
- $lt = 4;
- }
+ my ($step, $labtyp, $marktyp, $lti, $tmod) = $me->xtic_range_data( $range
);
+ my $t = $me->xtic_align_initial( $step );
- # print STDERR "xtics min=$me->{xd_min} max=$me->{xd_max} r=$r, st=$step,
low=$low, $n2/$n3/$n4\n";
- for( $t=$low; $t<$me->{xd_max}; $t+=$step ){
- my $ll;
+ # print "days: $range_days, lt: $labtyp, lti: $lti, tmod: $tmod, st:
$step\n";
+ # print STDERR "t: $t ", scalar(localtime $t), "\n";
+
+ for( ; $t<$me->{xd_max}; $t+=$step ){
+ my $redmark = 0;
next if $t < $me->{xd_min};
- my @lt = localtime $t;
- next if $lt[2] % $n2;
- next if ($lt[3] - 1) % $n3 || (($n3!=1) && $lt[3] > 22 );
- next if $lt[4] % $n4;
- if( $lt == 1 && !$lt[2] && !$lt[1] || # midnight
- $lt == 2 && !$lt[6] || # sunday
- $lt == 3 && $lt[3] == 1 && $rd < 60 || # 1st of month
- $lt == 3 && $lt[3] == 1 && $lt[4] == 0 # Jan 1
- ){
- $ll = 1;
+ my @lt = localtime $t;
+ my @rlt = @lt;
+ # months go from 0. days from 1. absurd!
+ $lt[3]--;
+ # mathematically, 28 is divisible by 7. but that just looks silly.
+ $lt[3] = 22 if $lt[3] > 22 && $lti==3 && $tmod >= 7;
+
+ if( $step >= 3600*24 && $lt[2] ){
+ # handle daylight saving time changes - resync to midnight
+ my $dt = ($lt[2] > 12 ? $lt[2] - 24 : $lt[2]) * 3600;
+ $dt += $lt[1] * 60;
+ $t -= $dt;
+ redo;
+ }
+ if( $step >= 3600*24*31 && $lt[3] ){
+ # some months are not 31 days!
+ # also corrects years that do not leap
+ my $dt = $lt[3] * 3600*24;
+ $t -= $dt;
+ redo;
}
+ next if $lt[$lti] % $tmod;
+ next if $lt[3] && $lti > 3;
+ next if $lt[2] && $lti > 2;
+ next if $lt[1] && $lti > 1;
+ next if $lt[0] && $lti > 0;
+
+
+ $redmark = 1 if $marktyp == $MT_HR && !$lt[1]; # on
the hour
+ $redmark = 1 if $marktyp == $MT_MN && !$lt[2] && !$lt[1]; #
midnight
+ $redmark = 1 if $marktyp == $MT_SU && !$lt[6]; # sunday
+ $redmark = 1 if $marktyp == $MT_M1 && !$lt[3]; # 1st
of month
+ $redmark = 1 if $marktyp == $MT_Y1 && !$lt[3] && !$lt[4]; # 1 jan
+
my $label;
- if( $lt == 1){
- $label = sprintf "%d:%0.2d", $lt[2], $lt[1]; # time
+ # NB: strftime obeys LC_TIME for localized day/month names
+ # (if locales are supported in the OS and perl)
+ if( $labtyp == $LT_HM ){
+ $label = sprintf "%d:%0.2d", $rlt[2], $rlt[1]; # time
}
- if( $lt == 2 ){
- if( $ll ){
- # NB: strftime obeys LC_TIME for localized day/month names
- # (if locales are supported in the OS and perl)
- $label = strftime("%d/%b", @lt); # date DD/Mon
+ if( $labtyp == $LT_HR ){
+ if( $redmark ){
+ $label = strftime("%d/%b", @rlt); # date DD/Mon
}else{
- $label = strftime("%a", @lt); # day of week
+ $label = sprintf "%d:%0.2d", $rlt[2], $rlt[1]; # time
}
}
- if( $lt == 3){
- if( $lt[3] == 1 && $lt[4] == 0 ){
- $label = $lt[5] + 1900; # year
+ if( $labtyp == $LT_DW ){
+ if( $redmark ){
+ $label = strftime("%d/%b", @rlt); # date DD/Mon
}else{
- $label = strftime("%d/%b", @lt); # date DD/Mon
+ $label = strftime("%a", @rlt); # day of week
}
}
- if( $lt == 4){
- $label = $lt[5] + 1900; # year
+ if( $labtyp == $LT_DM ){
+ if( !$lt[3] && !$lt[4] ){
+ $label = $rlt[5] + 1900; # year
+ }else{
+ $label = strftime("%d/%b", @rlt); # date DD/Mon
+ }
+ }
+ if( $labtyp == $LT_YR ){
+ $label = $rlt[5] + 1900; # year
}
- push @tics, [$t, $ll, $label];
+ push @tics, [$t, $redmark, $label];
}
- $me->{grid}{x} = [@tics];
-
+ $me->{grid}{x} = \@tics;
+
}
# it shall be inventoried, and every particle and utensil
@@ -864,32 +1002,37 @@ sub draw_filled {
my $im = $me->{img};
my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
- my($px, $py);
+ my($px, $py, $pxdpt, $pydpt);
+ my $ypt0 = $me->ypt(0);
foreach my $s ( @$data ){
my $x = $s->{time};
my $y = $s->{value};
-
+
next if $x < $me->{xd_min} || $x > $me->{xd_max};
- if( defined($y) || !$skipundef ){
+ my $xdpt = $me->xdatapt($x);
+ my $ydpt = $me->ydatapt($y);
- if( defined($px) && ($me->xdatapt($x) - $me->xdatapt($px) > 1) ){
- $px = $x - $limit if $limit && $x - $px > $limit;
-
+ if( defined($y) || !$skipundef ){
+
+ if( defined($px) && ($xdpt - $pxdpt > 1) && (!$limit || $x - $px <=
$limit) ){
my $poly = GD::Polygon->new;
- $poly->addPt($me->xdatapt($px), $me->ypt(0));
- $poly->addPt($me->xdatapt($px), $me->ydatapt($py));
- $poly->addPt($me->xdatapt($x), $me->ydatapt($y));
- $poly->addPt($me->xdatapt($x), $me->ypt(0));
+ $poly->addPt($pxdpt, $ypt0);
+ $poly->addPt($pxdpt, $pydpt);
+ $poly->addPt($xdpt, $ydpt);
+ $poly->addPt($xdpt, $ypt0);
$im->filledPolygon($poly, $me->color($s, $opts));
}else{
- $im->line( $me->xdatapt($x), $me->ypt(0),
- $me->xdatapt($x), $me->ydatapt($y),
+ $im->line( $xdpt, $ypt0,
+ $xdpt, $ydpt,
$me->color($s, $opts) );
}
+ $px = $x; $pxdpt = $xdpt;
+ $py = $y; $pydpt = $ydpt;
+ }else{
+ $px = undef;
}
- $px = $x; $py = $y;
}
}
@@ -902,7 +1045,7 @@ sub draw_line {
my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
my $thick = $opts->{thickness} || $me->{thickness};
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
- my($px, $py);
+ my($px, $py, $pxdpt, $pydpt);
$me->set_thickness( $thick ) if $thick;
@@ -911,19 +1054,24 @@ sub draw_line {
my $y = $s->{value};
next if $x < $me->{xd_min} || $x > $me->{xd_max};
+
+ my $xdpt = $me->xdatapt($x);
+ my $ydpt = $me->ydatapt($y);
if( defined($y) || !$skipundef ){
- if( defined($py) ){
- $px = $x - $limit if $limit && $x - $px > $limit;
- $im->line( $me->xdatapt($px), $me->ydatapt($py),
- $me->xdatapt($x), $me->ydatapt($y),
+ if( defined($px) && (!$limit || $x - $px <= $limit) ){
+ $im->line( $pxdpt, $pydpt,
+ $xdpt, $ydpt,
$me->color($s, $opts) );
}else{
- $im->setPixel($me->xdatapt($x), $me->ydatapt($y),
+ $im->setPixel($xdpt, $ydpt,
$me->color($s, $opts) );
}
+ $px = $x; $pxdpt = $xdpt;
+ $py = $y; $pydpt = $ydpt;
+ }else{
+ $px = undef;
}
- $px = $x; $py = $y;
}
$me->set_thickness( 1 ) if $thick;
}
@@ -932,40 +1080,42 @@ sub draw_range {
my $me = shift;
my $data = shift;
my $opts = shift;
-
+
my $im = $me->{img};
my $limit = $me->{limit_factor} * ($me->{xd_max} - $me->{xd_min}) / @$data;
my $skipundef = $opts->{skip_undefined} || $me->{skip_undefined};
- my($px, $pn, $pm);
+ my($px, $pn, $pm, $pxdpt);
foreach my $s ( @$data ){
- my $x = $s->{time};
- my $a = defined $s->{min} ? $s->{min} : $s->{value};
- my $b = defined $s->{max} ? $s->{max} : $s->{value};
-
- next if $x < $me->{xd_min} || $x > $me->{xd_max};
-
- $a = $b if !defined($a) && $skipundef;
- $b = $a if !defined($b) && $skipundef;
-
- if( defined($a) || !$skipundef ){
-
- if( defined($px) && ($me->xdatapt($x) - $me->xdatapt($px) > 1) ){
- my $poly = GD::Polygon->new;
- $px = $x - $limit if $limit && $x - $px > $limit;
-
- $poly->addPt($me->xdatapt($px), $me->ydatapt($pn));
- $poly->addPt($me->xdatapt($px), $me->ydatapt($pm));
- $poly->addPt($me->xdatapt($x), $me->ydatapt($b));
- $poly->addPt($me->xdatapt($x), $me->ydatapt($a));
- $im->filledPolygon($poly, $me->color($s, $opts));
- }else{
- $im->line( $me->xdatapt($x), $me->ydatapt($b),
- $me->xdatapt($x), $me->ydatapt($a),
- $me->color($s, $opts) );
- }
- }
- $px = $x; $pn = $a; $pm = $b;
+ my $x = $s->{time};
+ my $a = defined $s->{min} ? $s->{min} : $s->{value};
+ my $b = defined $s->{max} ? $s->{max} : $s->{value};
+ my $xdpt = $me->xdatapt($x);
+
+ next if $x < $me->{xd_min} || $x > $me->{xd_max};
+
+ $a = $b if !defined($a) && $skipundef;
+ $b = $a if !defined($b) && $skipundef;
+
+ if( defined($a) || !$skipundef ){
+
+ if( defined($px) && ($xdpt - $pxdpt > 1) && (!$limit || $x - $px <=
$limit) ){
+ my $poly = GD::Polygon->new;
+ $poly->addPt($pxdpt, $me->ydatapt($pn));
+ $poly->addPt($pxdpt, $me->ydatapt($pm));
+ $poly->addPt($xdpt, $me->ydatapt($b));
+ $poly->addPt($xdpt, $me->ydatapt($a));
+ $im->filledPolygon($poly, $me->color($s, $opts));
+ }else{
+ $im->line( $xdpt, $me->ydatapt($b),
+ $xdpt, $me->ydatapt($a),
+ $me->color($s, $opts) );
+ }
+ $px = $x; $pn = $a; $pm = $b;
+ $pxdpt = $xdpt;
+ }else{
+ $px = undef;
+ }
}
}
@@ -985,9 +1135,11 @@ sub draw_points {
next if $x < $me->{xd_min} || $x > $me->{xd_max};
next if !defined($y) && $skipundef;
+ my $xdpt = $me->xdatapt($x);
+ my $ydpt = $me->ydatapt($y);
while( $d > 0 ){
- $im->arc( $me->xdatapt($x), $me->ydatapt($y),
+ $im->arc( $xdpt, $ydpt,
$d, $d, 0, 360,
$c );
$d -= 2;
@@ -1049,7 +1201,7 @@ sub draw_boxes {
=head1 EXAMPLE IMAGES
http://argus.tcp4me.com/shots.html
- http://search.cpan.org/src/JAW/Chart-Strip-1.04/eg/
+ http://search.cpan.org/src/JAW/Chart-Strip-1.05/eg/
=head1 BUGS
diff --git a/t/test3.t b/t/test3.t
new file mode 100644
index 0000000..562e3ff
--- /dev/null
+++ b/t/test3.t
@@ -0,0 +1,433 @@
+
+# test new xtic code
+use Chart::Strip;
+use strict;
+
+my $MK = 0;
+my $H = 3600;
+my $D = $H * 24;
+my @t;
+
+eval {
+ # tests assume US/eastern, en_us. skip if we can't make compat.
+ require POSIX;
+ POSIX->import();
+ $ENV{TZ} = 'EST5EDT';
+ setlocale( LC_ALL(), "C" );
+ tzset();
+ if( localtime(1151726400) ne 'Sat Jul 1 00:00:00 2006' ){
+ die "tests not configured for this timezone/locale\n";
+ }
+};
+if($@){
+ print "1..0 # Skipped: cannot make timezone/locale compatible\n";
+ exit;
+}
+
+if( localtime(1175400000) ne 'Sun Apr 1 00:00:00 2007' ){
+ # the US govmit changed the daylight saving time rules.
+ # most OSes don't know that
+ # expect the fallout from this to be much worse than y2k.
+
+ print "1..0 # Skipped: OS has out of date daylight saving time rules\n";
+ exit;
+}
+
+# return xtic data for specified time range
+sub gen {
+ my $t0 = shift;
+ my $dur = shift;
+
+ my $c = Chart::Strip->new();
+ $c->add_data( [ {time => $t0, value => 1},
+ {time => $t0 + $dur, value => 1}],
+ { style => 'line' });
+ $c->plot();
+ $c->{grid}{x};
+}
+
+sub test {
+ my $t = shift;
+ my $mk = shift;
+
+ if( !ref $t ){
+ print "$t\n" if $mk;
+ return 'ok';
+ }
+
+ my $t0 = $t->{start};
+ my $dur = $t->{dur};
+ my $exp = $t->{exp};
+
+ $dur = $1 * $D if $dur =~ /(\d+)D/;
+ $dur = $1 * $H if $dur =~ /(\d+)H/;
+
+ my $res = gen( $t0, $dur );
+
+ my $err;
+ $err = 1 if @$res != @$exp;
+
+ if( $mk ){
+ my $pv;
+ for my $r (@$res){
+ my $dt = $pv ? $r->[0] - $pv : '';
+ print "$t->{dur}\t$t0\t$r->[0]\t$r->[1]\t$r->[2]\t$dt\n";
+ $pv = $r->[0];
+ }
+ print "\n";
+ }
+
+ for my $e (@$exp){
+ my $terr;
+ my $r = shift @$res;
+ $terr = 1 unless $e->[0] == $r->[0];
+ $terr = 1 unless $e->[1] == $r->[1];
+ $terr = 1 unless $e->[2] eq $r->[2];
+ $err ||= $terr;
+
+ print STDERR "error: @$e != @$r\n"
+ if $terr;
+ }
+
+
+ $err ? 'not ok' : 'ok';
+}
+
+
+my $pd = '';
+while(<DATA>){
+ chop;
+ my @l = split;
+ my $dur = $l[0];
+ my $t0 = $l[1];
+ my $exp = [@l[2,3,4,5]];
+
+ if( /^\#/ ){
+ # preserve comments
+ push @t, $_;
+ next;
+ }
+ next unless $dur;
+
+ if($dur eq $pd){
+ push @{$t[-1]{exp}}, $exp;
+ }else{
+ push @t, { dur => $dur, start => $t0, exp => [$exp] };
+ }
+ $pd = $dur;
+}
+
+print "1..", scalar @t, "\n" unless $MK;
+my $n = 1;
+foreach my $t (@t){
+ my $r = test($t, $MK);
+ print "$r ", $n++, "\n" unless $MK;
+}
+
+# duration start expected result: tic-time, redmark, label, delta(not-used)
+__END__
+2100D 1151726400 1167627600 0 2007
+2100D 1151726400 1199163600 0 2008 31536000
+2100D 1151726400 1230786000 0 2009 31622400
+2100D 1151726400 1262322000 0 2010 31536000
+2100D 1151726400 1293858000 0 2011 31536000
+2100D 1151726400 1325394000 0 2012 31536000
+
+1500D 1151726400 1151726400 0 01/Jul
+1500D 1151726400 1167627600 0 2007 15901200
+1500D 1151726400 1183262400 0 01/Jul 15634800
+1500D 1151726400 1199163600 0 2008 15901200
+1500D 1151726400 1214884800 0 01/Jul 15721200
+1500D 1151726400 1230786000 0 2009 15901200
+1500D 1151726400 1246420800 0 01/Jul 15634800
+1500D 1151726400 1262322000 0 2010 15901200
+1500D 1151726400 1277956800 0 01/Jul 15634800
+
+750D 1151726400 1151726400 0 01/Jul
+750D 1151726400 1159675200 0 01/Oct 7948800
+750D 1151726400 1167627600 1 2007 7952400
+750D 1151726400 1175400000 0 01/Apr 7776000
+750D 1151726400 1183262400 0 01/Jul 7858800
+750D 1151726400 1191211200 0 01/Oct 7948800
+750D 1151726400 1199163600 1 2008 7952400
+750D 1151726400 1207022400 0 01/Apr 7862400
+750D 1151726400 1214884800 0 01/Jul 7858800
+
+400D 1151726400 1151726400 0 01/Jul
+400D 1151726400 1157083200 0 01/Sep 5356800
+400D 1151726400 1162357200 0 01/Nov 5274000
+400D 1151726400 1167627600 1 2007 5270400
+400D 1151726400 1172725200 0 01/Mar 5097600
+400D 1151726400 1177992000 0 01/May 5266800
+400D 1151726400 1183262400 0 01/Jul 5270400
+
+200D 1151726400 1151726400 0 01/Jul
+200D 1151726400 1154404800 0 01/Aug 2678400
+200D 1151726400 1157083200 0 01/Sep 2678400
+200D 1151726400 1159675200 0 01/Oct 2592000
+200D 1151726400 1162357200 0 01/Nov 2682000
+200D 1151726400 1164949200 0 01/Dec 2592000
+200D 1151726400 1167627600 1 2007 2678400
+
+100D 1151726400 1151726400 0 01/Jul
+100D 1151726400 1152936000 0 15/Jul 1209600
+100D 1151726400 1154404800 0 01/Aug 1468800
+100D 1151726400 1155614400 0 15/Aug 1209600
+100D 1151726400 1157083200 0 01/Sep 1468800
+100D 1151726400 1158292800 0 15/Sep 1209600
+100D 1151726400 1159675200 0 01/Oct 1382400
+
+50D 1151726400 1151726400 1 01/Jul
+50D 1151726400 1152331200 0 08/Jul 604800
+50D 1151726400 1152936000 0 15/Jul 604800
+50D 1151726400 1153540800 0 22/Jul 604800
+50D 1151726400 1154404800 1 01/Aug 864000
+50D 1151726400 1155009600 0 08/Aug 604800
+50D 1151726400 1155614400 0 15/Aug 604800
+
+20D 1151726400 1151726400 1 01/Jul
+20D 1151726400 1151899200 0 03/Jul 172800
+20D 1151726400 1152072000 0 05/Jul 172800
+20D 1151726400 1152244800 0 07/Jul 172800
+20D 1151726400 1152417600 0 09/Jul 172800
+20D 1151726400 1152590400 0 11/Jul 172800
+20D 1151726400 1152763200 0 13/Jul 172800
+20D 1151726400 1152936000 0 15/Jul 172800
+20D 1151726400 1153108800 0 17/Jul 172800
+20D 1151726400 1153281600 0 19/Jul 172800
+
+12D 1151726400 1151726400 0 Sat
+12D 1151726400 1151812800 1 02/Jul 86400
+12D 1151726400 1151899200 0 Mon 86400
+12D 1151726400 1151985600 0 Tue 86400
+12D 1151726400 1152072000 0 Wed 86400
+12D 1151726400 1152158400 0 Thu 86400
+12D 1151726400 1152244800 0 Fri 86400
+12D 1151726400 1152331200 0 Sat 86400
+12D 1151726400 1152417600 1 09/Jul 86400
+12D 1151726400 1152504000 0 Mon 86400
+12D 1151726400 1152590400 0 Tue 86400
+12D 1151726400 1152676800 0 Wed 86400
+
+6D 1151726400 1151726400 0 Sat
+6D 1151726400 1151812800 1 02/Jul 86400
+6D 1151726400 1151899200 0 Mon 86400
+6D 1151726400 1151985600 0 Tue 86400
+6D 1151726400 1152072000 0 Wed 86400
+6D 1151726400 1152158400 0 Thu 86400
+
+3D 1151726400 1151726400 1 01/Jul
+3D 1151726400 1151748000 0 6:00 21600
+3D 1151726400 1151769600 0 12:00 21600
+3D 1151726400 1151791200 0 18:00 21600
+3D 1151726400 1151812800 1 02/Jul 21600
+3D 1151726400 1151834400 0 6:00 21600
+3D 1151726400 1151856000 0 12:00 21600
+3D 1151726400 1151877600 0 18:00 21600
+3D 1151726400 1151899200 1 03/Jul 21600
+3D 1151726400 1151920800 0 6:00 21600
+3D 1151726400 1151942400 0 12:00 21600
+3D 1151726400 1151964000 0 18:00 21600
+
+2D 1151726400 1151726400 1 01/Jul
+2D 1151726400 1151740800 0 4:00 14400
+2D 1151726400 1151755200 0 8:00 14400
+2D 1151726400 1151769600 0 12:00 14400
+2D 1151726400 1151784000 0 16:00 14400
+2D 1151726400 1151798400 0 20:00 14400
+2D 1151726400 1151812800 1 02/Jul 14400
+2D 1151726400 1151827200 0 4:00 14400
+2D 1151726400 1151841600 0 8:00 14400
+2D 1151726400 1151856000 0 12:00 14400
+2D 1151726400 1151870400 0 16:00 14400
+2D 1151726400 1151884800 0 20:00 14400
+
+18H 1151726400 1151726400 1 01/Jul
+18H 1151726400 1151733600 0 2:00 7200
+18H 1151726400 1151740800 0 4:00 7200
+18H 1151726400 1151748000 0 6:00 7200
+18H 1151726400 1151755200 0 8:00 7200
+18H 1151726400 1151762400 0 10:00 7200
+18H 1151726400 1151769600 0 12:00 7200
+18H 1151726400 1151776800 0 14:00 7200
+18H 1151726400 1151784000 0 16:00 7200
+
+9H 1151726400 1151726400 1 01/Jul
+9H 1151726400 1151730000 0 1:00 3600
+9H 1151726400 1151733600 0 2:00 3600
+9H 1151726400 1151737200 0 3:00 3600
+9H 1151726400 1151740800 0 4:00 3600
+9H 1151726400 1151744400 0 5:00 3600
+9H 1151726400 1151748000 0 6:00 3600
+9H 1151726400 1151751600 0 7:00 3600
+9H 1151726400 1151755200 0 8:00 3600
+
+# check near leap year (near 1Mar2004)
+6H 1078106400 1078106400 0 21:00
+6H 1078106400 1078110000 0 22:00 3600
+6H 1078106400 1078113600 0 23:00 3600
+6H 1078106400 1078117200 1 01/Mar 3600
+6H 1078106400 1078120800 0 1:00 3600
+6H 1078106400 1078124400 0 2:00 3600
+
+22H 1078074000 1078074000 0 12:00
+22H 1078074000 1078081200 0 14:00 7200
+22H 1078074000 1078088400 0 16:00 7200
+22H 1078074000 1078095600 0 18:00 7200
+22H 1078074000 1078102800 0 20:00 7200
+22H 1078074000 1078110000 0 22:00 7200
+22H 1078074000 1078117200 1 01/Mar 7200
+22H 1078074000 1078124400 0 2:00 7200
+22H 1078074000 1078131600 0 4:00 7200
+22H 1078074000 1078138800 0 6:00 7200
+22H 1078074000 1078146000 0 8:00 7200
+
+14D 1077512400 1077512400 0 Mon
+14D 1077512400 1077598800 0 Tue 86400
+14D 1077512400 1077685200 0 Wed 86400
+14D 1077512400 1077771600 0 Thu 86400
+14D 1077512400 1077858000 0 Fri 86400
+14D 1077512400 1077944400 0 Sat 86400
+14D 1077512400 1078030800 1 29/Feb 86400
+14D 1077512400 1078117200 0 Mon 86400
+14D 1077512400 1078203600 0 Tue 86400
+14D 1077512400 1078290000 0 Wed 86400
+14D 1077512400 1078376400 0 Thu 86400
+14D 1077512400 1078462800 0 Fri 86400
+14D 1077512400 1078549200 0 Sat 86400
+14D 1077512400 1078635600 1 07/Mar 86400
+
+20D 1077512400 1077512400 0 23/Feb
+20D 1077512400 1077685200 0 25/Feb 172800
+20D 1077512400 1077858000 0 27/Feb 172800
+20D 1077512400 1078030800 0 29/Feb 172800
+20D 1077512400 1078117200 1 01/Mar 86400
+20D 1077512400 1078290000 0 03/Mar 172800
+20D 1077512400 1078462800 0 05/Mar 172800
+20D 1077512400 1078635600 0 07/Mar 172800
+20D 1077512400 1078808400 0 09/Mar 172800
+20D 1077512400 1078981200 0 11/Mar 172800
+20D 1077512400 1079154000 0 13/Mar 172800
+
+# and near non-leap year (near 1Mar2005)
+6H 1109642400 1109642400 0 21:00
+6H 1109642400 1109646000 0 22:00 3600
+6H 1109642400 1109649600 0 23:00 3600
+6H 1109642400 1109653200 1 01/Mar 3600
+6H 1109642400 1109656800 0 1:00 3600
+6H 1109642400 1109660400 0 2:00 3600
+
+22H 1109610000 1109610000 0 12:00
+22H 1109610000 1109617200 0 14:00 7200
+22H 1109610000 1109624400 0 16:00 7200
+22H 1109610000 1109631600 0 18:00 7200
+22H 1109610000 1109638800 0 20:00 7200
+22H 1109610000 1109646000 0 22:00 7200
+22H 1109610000 1109653200 1 01/Mar 7200
+22H 1109610000 1109660400 0 2:00 7200
+22H 1109610000 1109667600 0 4:00 7200
+22H 1109610000 1109674800 0 6:00 7200
+22H 1109610000 1109682000 0 8:00 7200
+
+14D 1109048400 1109048400 0 Tue
+14D 1109048400 1109134800 0 Wed 86400
+14D 1109048400 1109221200 0 Thu 86400
+14D 1109048400 1109307600 0 Fri 86400
+14D 1109048400 1109394000 0 Sat 86400
+14D 1109048400 1109480400 1 27/Feb 86400
+14D 1109048400 1109566800 0 Mon 86400
+14D 1109048400 1109653200 0 Tue 86400
+14D 1109048400 1109739600 0 Wed 86400
+14D 1109048400 1109826000 0 Thu 86400
+14D 1109048400 1109912400 0 Fri 86400
+14D 1109048400 1109998800 0 Sat 86400
+14D 1109048400 1110085200 1 06/Mar 86400
+14D 1109048400 1110171600 0 Mon 86400
+
+20D 1109048400 1109134800 0 23/Feb
+20D 1109048400 1109307600 0 25/Feb 172800
+20D 1109048400 1109480400 0 27/Feb 172800
+20D 1109048400 1109653200 1 01/Mar 172800
+20D 1109048400 1109826000 0 03/Mar 172800
+20D 1109048400 1109998800 0 05/Mar 172800
+20D 1109048400 1110171600 0 07/Mar 172800
+20D 1109048400 1110344400 0 09/Mar 172800
+20D 1109048400 1110517200 0 11/Mar 172800
+20D 1109048400 1110690000 0 13/Mar 172800
+
+# check near time change (2Apr)
+4H 1143954000 1143954000 1 02/Apr
+4H 1143954000 1143955800 0 0:30 1800
+4H 1143954000 1143957600 0 1:00 1800
+4H 1143954000 1143959400 0 1:30 1800
+4H 1143954000 1143961200 0 3:00 1800
+4H 1143954000 1143963000 0 3:30 1800
+4H 1143954000 1143964800 0 4:00 1800
+4H 1143954000 1143966600 0 4:30 1800
+
+8H 1143954000 1143954000 1 02/Apr
+8H 1143954000 1143957600 0 1:00 3600
+8H 1143954000 1143961200 0 3:00 3600
+8H 1143954000 1143964800 0 4:00 3600
+8H 1143954000 1143968400 0 5:00 3600
+8H 1143954000 1143972000 0 6:00 3600
+8H 1143954000 1143975600 0 7:00 3600
+8H 1143954000 1143979200 0 8:00 3600
+
+2D 1143954000 1143954000 1 02/Apr
+2D 1143954000 1143964800 0 4:00 10800
+2D 1143954000 1143979200 0 8:00 14400
+2D 1143954000 1143993600 0 12:00 14400
+2D 1143954000 1144008000 0 16:00 14400
+2D 1143954000 1144022400 0 20:00 14400
+2D 1143954000 1144036800 1 03/Apr 14400
+2D 1143954000 1144051200 0 4:00 14400
+2D 1143954000 1144065600 0 8:00 14400
+2D 1143954000 1144080000 0 12:00 14400
+2D 1143954000 1144094400 0 16:00 14400
+2D 1143954000 1144108800 0 20:00 14400
+2D 1143954000 1144123200 1 04/Apr 14400
+
+4D 1143954000 1143954000 1 02/Apr
+4D 1143954000 1144036800 0 Mon 82800
+4D 1143954000 1144123200 0 Tue 86400
+4D 1143954000 1144209600 0 Wed 86400
+4D 1143954000 1144296000 0 Thu 86400
+
+# check near time change (29Oct)
+4H 1162094400 1162094400 1 29/Oct
+4H 1162094400 1162096200 0 0:30 1800
+4H 1162094400 1162098000 0 1:00 1800
+4H 1162094400 1162099800 0 1:30 1800
+4H 1162094400 1162101600 0 1:00 1800
+4H 1162094400 1162103400 0 1:30 1800
+4H 1162094400 1162105200 0 2:00 1800
+4H 1162094400 1162107000 0 2:30 1800
+
+8H 1162094400 1162094400 1 29/Oct
+8H 1162094400 1162098000 0 1:00 3600
+8H 1162094400 1162101600 0 1:00 3600
+8H 1162094400 1162105200 0 2:00 3600
+8H 1162094400 1162108800 0 3:00 3600
+8H 1162094400 1162112400 0 4:00 3600
+8H 1162094400 1162116000 0 5:00 3600
+8H 1162094400 1162119600 0 6:00 3600
+
+2D 1162094400 1162094400 1 29/Oct
+2D 1162094400 1162112400 0 4:00 18000
+2D 1162094400 1162126800 0 8:00 14400
+2D 1162094400 1162141200 0 12:00 14400
+2D 1162094400 1162155600 0 16:00 14400
+2D 1162094400 1162170000 0 20:00 14400
+2D 1162094400 1162184400 1 30/Oct 14400
+2D 1162094400 1162198800 0 4:00 14400
+2D 1162094400 1162213200 0 8:00 14400
+2D 1162094400 1162227600 0 12:00 14400
+2D 1162094400 1162242000 0 16:00 14400
+2D 1162094400 1162256400 0 20:00 14400
+
+4D 1162094400 1162094400 1 29/Oct
+4D 1162094400 1162184400 0 Mon 90000
+4D 1162094400 1162270800 0 Tue 86400
+4D 1162094400 1162357200 0 Wed 86400
+
--
Alioth's /usr/local/bin/git-commit-notice on
/srv/git.debian.org/git/pkg-perl/packages/libchart-strip-perl.git.git
_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits
