perl/IsoTime.pm

   1 #
   2 # Utility routines for handling Iso 8601 date time groups
   3 #
   4 # $Id$
   5 #
   6 # Copyright (c) Dirk Koopman, G1TLH
   7 #
   8
   9 use strict;
  10
  11 package IsoTime;
  12
  13 use Date::Parse;
  14
  15 use vars qw($VERSION $BRANCH $year $month $day $hour $min $sec @days @ldays);
  16 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  17 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  18 $main::build += $VERSION;
  19 $main::branch += $BRANCH;
  20
  21 @days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  22 @ldays = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  23
  24 # is it a leap year?
  25 sub _isleap
  26 {
  27         my $year = shift;
  28         return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0;
  29 }
  30
  31 sub full
  32 {
  33         return sprintf "%04d%02d%02dT%02d%02d%02d", $year, $month, $day, $hour, $min, $sec;
  34 }
  35
  36 sub dayminsec
  37 {
  38         return sprintf "%02dT%02d%02d%02d", $day, $hour, $min, $sec;
  39 }
  40
  41 sub daymin
  42 {
  43         return sprintf "%02dT%02d%02d", $day, $hour, $min;
  44 }
  45
  46 sub hourmin
  47 {
  48         return sprintf "%02d%02d", $hour, $min;
  49
  50 }
  51
  52 sub hourminsec
  53 {
  54         return sprintf "%02d%02d%02d", $hour, $min, $sec;
  55 }
  56
  57 sub update
  58 {
  59         my $t = shift || time;
  60         ($sec,$min,$hour,$day,$month,$year) = gmtime($t);
  61         $month++;
  62         $year += 1900;
  63 }
  64
  65 sub unixtime
  66 {
  67         my $iso = shift;
  68
  69         # get the correct day, if required
  70         if (my ($h) = $iso =~ /^([012]\d)[0-5]\d(?:[0-5]\d)?$/) {
  71                 my ($d, $m, $y) = ($day, $month, $year);
  72                 if ($h != $hour) {
  73                         if ($hour < 12 && $h - $hour >= 12) {
  74                                 # yesterday
  75                                 ($d, $m, $y) = _yesterday($d, $m, $y);
  76                         } elsif ($hour >= 12 && $hour - $h > 12) {
  77                                 # tomorrow
  78                                 ($d, $m, $y) = _tomorrow($d, $m, $y);
  79                         }
  80                 }
  81                 $iso = sprintf("%04d%02d%02dT", $y, $m, $d) . $iso;
  82         } elsif (my ($d) = $iso =~ /^(\d\d)T\d\d\d\d/) {
  83
  84                 # get the correct month and year if it is a short date
  85                 if ($d == $day) {
  86                         $iso = sprintf("%04d%02d", $year, $month) . $iso;
  87                 } else {
  88                         my $days = _isleap($year) ? $ldays[$month-1] : $days[$month-1];
  89                         my ($y, $m) = ($year, $month);
  90                         if ($d < $day) {
  91                                 if ($day - $d > $days / 2) {
  92                                         if ($month == 1) {
  93                                                 $y = $year - 1;
  94                                                 $m = 12;
  95                                         } else {
  96                                                 $m = $month - 1;
  97                                         }
  98                                 }
  99                         } else {
 100                                 if ($d - $day > $days / 2) {
 101                                         if ($month == 12) {
 102                                                 $y = $year + 1;
 103                                                 $m = 1;
 104                                         } else {
 105                                                 $m = $month + 1;
 106                                         }
 107                                 }
 108                         }
 109                         $iso = sprintf("%04d%02d", $y, $m) . $iso;
 110                 }
 111         }
 112
 113         return str2time($iso);
 114 }
 115
 116 sub _tomorrow
 117 {
 118         my ($d, $m, $y) = @_;
 119
 120         $d++;
 121         my $days = _isleap($y) ? $ldays[$month-1] : $days[$month-1];
 122         if ($d > $days) {
 123                 $d = 1;
 124                 $m++;
 125                 if ($m > 12) {
 126                         $m = 1;
 127                         $y++;
 128                 } else {
 129                         $y = $year;
 130                 }
 131         }
 132
 133         return ($d, $m, $y);
 134 }
 135
 136 sub _yesterday
 137 {
 138         my ($d, $m, $y) = @_;
 139
 140         $d--;
 141         if ($d <= 0) {
 142                 $m--;
 143                 $y = $year;
 144                 if ($m <= 0) {
 145                         $m = 12;
 146                         $y--;
 147                 }
 148                 $d = _isleap($y) ? $ldays[$m-1] : $days[$m-1];
 149         }
 150
 151         return ($d, $m, $y);
 152 }
 153 1;