| 1 | ##---------------------------------------------------------------------------## |
| 2 | ## File: |
| 3 | ## $Id: mhtime.pl,v 2.10 2001/09/17 16:09:35 ehood Exp $ |
| 4 | ## Author: |
| 5 | ## Earl Hood mhonarc@mhonarc.org |
| 6 | ## Description: |
| 7 | ## Time related routines for mhonarc |
| 8 | ##---------------------------------------------------------------------------## |
| 9 | ## Copyright (C) 1996-1999 Earl Hood, mhonarc@mhonarc.org |
| 10 | ## |
| 11 | ## This program is free software; you can redistribute it and/or modify |
| 12 | ## it under the terms of the GNU General Public License as published by |
| 13 | ## the Free Software Foundation; either version 2 of the License, or |
| 14 | ## (at your option) any later version. |
| 15 | ## |
| 16 | ## This program is distributed in the hope that it will be useful, |
| 17 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ## GNU General Public License for more details. |
| 20 | ## |
| 21 | ## You should have received a copy of the GNU General Public License |
| 22 | ## along with this program; if not, write to the Free Software |
| 23 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA |
| 24 | ## 02111-1307, USA |
| 25 | ##---------------------------------------------------------------------------## |
| 26 | |
| 27 | package mhonarc; |
| 28 | |
| 29 | ##---------------------------------------------------------------------------## |
| 30 | ## Date variables for date routines |
| 31 | ## |
| 32 | my %Month2Num = ( |
| 33 | 'jan', 0, 'feb', 1, 'mar', 2, 'apr', 3, 'may', 4, 'jun', 5, 'jul', 6, |
| 34 | 'aug', 7, 'sep', 8, 'oct', 9, 'nov', 10, 'dec', 11, |
| 35 | 'january', 0, 'february', 1, 'march', 2, 'april', 3, |
| 36 | 'may', 4, 'june', 5, 'july', 6, 'august', 7, |
| 37 | 'september', 8, 'october', 9, 'november', 10, 'december', 11, |
| 38 | ); |
| 39 | my %WDay2Num = ( |
| 40 | 'sun', 0, 'mon', 1, 'tue', 2, 'wed', 3, 'thu', 4, 'fri', 5, 'sat', 6, |
| 41 | 'sunday', 0, 'monday', 1, 'tuesday', 2, 'wednesday', 3, 'thursday', 4, |
| 42 | 'friday', 5, 'saturday', 6, |
| 43 | ); |
| 44 | |
| 45 | my @wdays = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'); |
| 46 | my @Wdays = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', |
| 47 | 'Friday', 'Saturday'); |
| 48 | my @mons = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', |
| 49 | 'Sep', 'Oct', 'Nov', 'Dec'); |
| 50 | my @Mons = ('January', 'February', 'March', 'April', 'May', 'June', |
| 51 | 'July', 'August', 'September', 'October', 'November', |
| 52 | 'December'); |
| 53 | |
| 54 | ## The following used in parse_date() regexes |
| 55 | my $p_weekdays = 'Mon|Tue|Wed|Thu|Fri|Sat|Sun'; |
| 56 | my $p_Weekdays = 'Monday|Tuesday|Wednesday|Thursday|Friday|Saturday|Sunday'; |
| 57 | my $p_months = 'Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec'; |
| 58 | my $p_Months = 'January|February|March|April|May|June|July|August'. |
| 59 | '|September|October|November|December'; |
| 60 | my $p_hrminsec = '\d{1,2}:\d\d:\d\d'; |
| 61 | my $p_hrmin = '\d{1,2}:\d\d'; |
| 62 | my $p_day = '\d{1,2}'; |
| 63 | my $p_year = '\d\d\d\d|\d\d'; |
| 64 | |
| 65 | ##--------------------------------------------------------------------------- |
| 66 | ## Set weekday and month names. This allows localization of |
| 67 | ## names. |
| 68 | ## |
| 69 | sub set_date_names { |
| 70 | my($in_wd, $in_Wd, $in_m, $in_M) = @_; |
| 71 | @wdays = @$in_wd if defined($in_wd) && scalar(@$in_wd); |
| 72 | @Wdays = @$in_Wd if defined($in_Wd) && scalar(@$in_Wd); |
| 73 | @mons = @$in_m if defined($in_m) && scalar(@$in_m); |
| 74 | @Mons = @$in_M if defined($in_M) && scalar(@$in_M); |
| 75 | } |
| 76 | |
| 77 | ##--------------------------------------------------------------------------- |
| 78 | ## Get date in date(1)-like format. $local flag is if local time |
| 79 | ## should be used. |
| 80 | ## |
| 81 | sub getdate { |
| 82 | &time2str('', time, $_[0]); |
| 83 | } |
| 84 | |
| 85 | ##--------------------------------------------------------------------------- |
| 86 | ## Convert a calander time to a string. |
| 87 | ## |
| 88 | sub time2str { |
| 89 | my($fmt, $time, $local) = @_; |
| 90 | my($date) = ""; |
| 91 | |
| 92 | ## Get current date/time |
| 93 | my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = |
| 94 | ($local ? localtime($time) : gmtime($time)); |
| 95 | |
| 96 | ## If format string blank, use default format |
| 97 | if ($fmt !~ /\S/) { |
| 98 | $fmt = '%a %b %d %H:%M:%S'; |
| 99 | $fmt .= ' GMT' unless $local; |
| 100 | $fmt .= ' %Y'; |
| 101 | } |
| 102 | |
| 103 | POSIXMODCHK: { |
| 104 | last POSIXMODCHK unless $POSIXstrftime; |
| 105 | eval { require POSIX; }; |
| 106 | last POSIXMODCHK if ($@) || !defined(&POSIX::strftime); |
| 107 | return POSIX::strftime($fmt, $sec,$min,$hour,$mday,$mon,$year, |
| 108 | $wday,$yday,$isdst); |
| 109 | } |
| 110 | |
| 111 | ## Get here, we have to do it ourselves. |
| 112 | my($yearfull, $hour12); |
| 113 | $yearfull = $year + 1900; |
| 114 | $year = $year % 100; |
| 115 | $hour12 = $hour > 12 ? $hour-12 : $hour; |
| 116 | |
| 117 | ## Format output |
| 118 | $fmt =~ s/\%c/\%a \%b \%d \%H:\%M:\%S \%Y/g; |
| 119 | |
| 120 | $fmt =~ s/\%a/$wdays[$wday]/g; |
| 121 | $fmt =~ s/\%A/$Wdays[$wday]/g; |
| 122 | $fmt =~ s/\%[bh]/$mons[$mon]/g; |
| 123 | $fmt =~ s/\%B/$Mons[$mon]/g; |
| 124 | |
| 125 | $sec = sprintf("%02d", $sec); |
| 126 | $min = sprintf("%02d", $min); |
| 127 | $hour = sprintf("%02d", $hour); |
| 128 | $hour12 = sprintf("%02d", $hour12); |
| 129 | $mday = sprintf("%02d", $mday); |
| 130 | $mon = sprintf("%02d", $mon+1); |
| 131 | $year = sprintf("%02d", $year); |
| 132 | $yearfull = sprintf("%04d", $yearfull); |
| 133 | $wday = sprintf("%02d", $wday+1); |
| 134 | $yday = sprintf("%03d", $yday); |
| 135 | |
| 136 | $fmt =~ s/\%d/$mday/g; |
| 137 | $fmt =~ s/\%H/$hour/g; |
| 138 | $fmt =~ s/\%I/$hour12/g; |
| 139 | $fmt =~ s/\%j/$yday/g; |
| 140 | $fmt =~ s/\%m/$mon/g; |
| 141 | $fmt =~ s/\%M/$min/g; |
| 142 | $fmt =~ s/\%n/\n/g; |
| 143 | $fmt =~ s/\%p/am/g if ($hour < 12); |
| 144 | $fmt =~ s/\%p/pm/g if ($hour >= 12); |
| 145 | $fmt =~ s/\%P/AM/g if ($hour < 12); |
| 146 | $fmt =~ s/\%P/PM/g if ($hour >= 12); |
| 147 | $fmt =~ s/\%S/$sec/g; |
| 148 | $fmt =~ s/\%w/$wday/g; |
| 149 | $fmt =~ s/\%y/$year/g; |
| 150 | $fmt =~ s/\%Y/$yearfull/g; |
| 151 | |
| 152 | $fmt =~ s/\%\%/\%/g ; |
| 153 | |
| 154 | $date = $fmt ; |
| 155 | |
| 156 | $date ; |
| 157 | } |
| 158 | |
| 159 | ##--------------------------------------------------------------------------- |
| 160 | ## parse_date takes a string date specified like the output of |
| 161 | ## date(1) into its components. Parsing a string for a date is |
| 162 | ## ugly since we have to watch out for differing formats. |
| 163 | ## |
| 164 | ## The following date formats are looked for: |
| 165 | ## |
| 166 | ## Wdy DD Mon YY HH:MM:SS Zone |
| 167 | ## DD Mon YY HH:MM:SS Zone |
| 168 | ## Wdy Mon DD HH:MM:SS Zone YYYY |
| 169 | ## Wdy Mon DD HH:MM:SS YYYY |
| 170 | ## |
| 171 | ## The routine keys off of the day of time field "HH:MM:SS" and |
| 172 | ## scans realtive to its location. |
| 173 | ## |
| 174 | ## If the parse fails, a null array is returned. Thus the routine |
| 175 | ## may be used as follows: |
| 176 | ## |
| 177 | ## if ( (@x = &parse_date($date)) ) { Success } |
| 178 | ## else { Fail } |
| 179 | ## |
| 180 | ## If success the array contents are as follows: |
| 181 | ## |
| 182 | ## (Weekday (0-6), Day of the month (1-31), Month (0-11), |
| 183 | ## Year, Hour, Minutes, Seconds, Time Zone) |
| 184 | ## |
| 185 | ## Contributer(s): Frank J. Manion <FJ_Manion@fccc.edu> |
| 186 | ## |
| 187 | sub parse_date { |
| 188 | my($date) = $_[0]; |
| 189 | my($wday, $mday, $mon, $yr, $time, $hr, $min, $sec, $zone); |
| 190 | my(@array); |
| 191 | my($start, $rest); |
| 192 | |
| 193 | # Try to find the date by focusing on the "\d\d:\d\d" field. |
| 194 | # All parsing is then done relative to this location. |
| 195 | # |
| 196 | $date =~ s/^\s+//; $time = ""; $rest = ""; |
| 197 | # Don't use $p_hrmin(sec) vars in split due to bug in perl 5.003. |
| 198 | ($start, $time, $rest) = split(/(\b\d{1,2}:\d\d:\d\d)/o, $date, 2); |
| 199 | ($start, $time, $rest) = split(/(\b\d{1,2}:\d\d)/o, $date, 2) |
| 200 | if !defined($time) or $time eq ""; |
| 201 | return () |
| 202 | unless defined($time) and $time ne ""; |
| 203 | |
| 204 | ($hr, $min, $sec) = split(/:/, $time); |
| 205 | $sec = 0 unless $sec; # Sometimes seconds not defined |
| 206 | |
| 207 | # Strip $start of all but the last 4 tokens, |
| 208 | # and stuff all tokens in $rest into @array |
| 209 | # |
| 210 | @array = split(' ', $start); |
| 211 | $start = join(' ', ($#array-3 < 0) ? @array[0..$#array] : |
| 212 | @array[$#array-3..$#array]); |
| 213 | @array = split(' ', $rest); |
| 214 | $rest = join(' ', ($#array >= 1) ? @array[0..1] : |
| 215 | $array[0]); |
| 216 | # Wdy DD Mon YY HH:MM:SS Zone |
| 217 | if ( $start =~ |
| 218 | /($p_weekdays),*\s+($p_day)\s+($p_months)\s+($p_year)$/io ) { |
| 219 | |
| 220 | ($wday, $mday, $mon, $yr, $zone) = ($1, $2, $3, $4, $array[0]); |
| 221 | |
| 222 | # DD Mon YY HH:MM:SS Zone |
| 223 | } elsif ( $start =~ /($p_day)\s+($p_months)\s+($p_year)$/io ) { |
| 224 | ($mday, $mon, $yr, $zone) = ($1, $2, $3, $array[0]); |
| 225 | |
| 226 | # Wdy Mon DD HH:MM:SS Zone YYYY |
| 227 | # Wdy Mon DD HH:MM:SS YYYY |
| 228 | } elsif ( $start =~ /($p_weekdays),?\s+($p_months)\s+($p_day)$/io ) { |
| 229 | ($wday, $mon, $mday) = ($1, $2, $3); |
| 230 | if ( $rest =~ /^(\S+)\s+($p_year)/o ) { # Zone YYYY |
| 231 | ($zone, $yr) = ($1, $2); |
| 232 | } elsif ( $rest =~ /^($p_year)/o ) { # YYYY |
| 233 | ($yr) = ($1); |
| 234 | } else { # zilch, use current year |
| 235 | warn "Warning: No year in date ($date), using current\n"; |
| 236 | $yr = (localtime(time))[5]; |
| 237 | } |
| 238 | |
| 239 | # Weekday Month DD YYYY HH:MM Zone |
| 240 | } elsif ( $start =~ |
| 241 | /($p_Weekdays),?\s+($p_Months)\s+($p_day),?\s+($p_year)$/ ) { |
| 242 | ($wday, $mon, $mday, $yr, $zone) = ($1, $2, $3, $4, $array[0]); |
| 243 | |
| 244 | # All else fails! |
| 245 | } else { |
| 246 | return (); |
| 247 | } |
| 248 | |
| 249 | # Modify month and weekday for lookup |
| 250 | $mon = $Month2Num{lc $mon} if defined($mon); |
| 251 | $wday = $WDay2Num{lc $wday} if defined($wday); |
| 252 | |
| 253 | ($wday, $mday, $mon, $yr, $hr, $min, $sec, $zone); |
| 254 | } |
| 255 | |
| 256 | ##--------------------------------------------------------------------------- |
| 257 | ## Routine to convert time in seconds to a month, day, and year |
| 258 | ## format. The format can be "mmddyy", "yymmdd", "ddmmyy". The |
| 259 | ## year can be specifed as "yyyy" if a 4 digit year is needed. |
| 260 | ## |
| 261 | sub time2mmddyy { |
| 262 | my($time, $fmt) = ($_[0], $_[1]); |
| 263 | my($day,$mon,$year,$ylen,$tmp); |
| 264 | if ($time) { |
| 265 | ($day,$mon,$year) = (localtime($time))[3,4,5]; |
| 266 | $year += 1900; |
| 267 | |
| 268 | ## Compute length for year field |
| 269 | $ylen = $fmt =~ s/y/y/g; |
| 270 | substr($year, 0, 4 - $ylen) = ''; |
| 271 | |
| 272 | ## Create string |
| 273 | if ($fmt =~ /ddmmyy/i) { # DDMMYY |
| 274 | $tmp = sprintf("%02d/%02d/%0${ylen}d", $day, $mon+1, $year); |
| 275 | |
| 276 | } elsif ($fmt =~ /yymmdd/i) { # YYMMDD |
| 277 | $tmp = sprintf("%0${ylen}d/%02d/%02d", $year, $mon+1, $day); |
| 278 | |
| 279 | } else { # MMDDYY |
| 280 | $tmp = sprintf("%02d/%02d/%0${ylen}d", $mon+1, $day, $year); |
| 281 | } |
| 282 | |
| 283 | } else { |
| 284 | $tmp = "--/--/--"; |
| 285 | } |
| 286 | } |
| 287 | |
| 288 | ##--------------------------------------------------------------------------- |
| 289 | ## zone_offset_to_secs translates a [+-]HHMM zone offset to |
| 290 | ## seconds. |
| 291 | ## |
| 292 | sub zone_offset_to_secs { |
| 293 | my($off) = shift; |
| 294 | my($sign, $min); |
| 295 | |
| 296 | ## Check if just an hour specification |
| 297 | if (length($off) < 4) { |
| 298 | return $off * 3600; |
| 299 | } |
| 300 | ## Check for sign |
| 301 | if ($off =~ s/-//) { |
| 302 | $sign = -1; |
| 303 | } else { |
| 304 | $sign = 1; s/\+//; |
| 305 | } |
| 306 | ## Extract minutes |
| 307 | $min = substr($off, -2, 2); |
| 308 | substr($off, -2, 2) = ""; # Just leave hour in $off |
| 309 | |
| 310 | ## Translate to seconds |
| 311 | $sign * (($off * 3600) + ($min * 60)); |
| 312 | } |
| 313 | |
| 314 | ##---------------------------------------------------------------------------## |
| 315 | 1; |