perl/IsoTime.pm

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