lib/DateUtils.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: DateUtils.pm,v $
   4
   5 Simple date/time utilities
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.32 $
  18
  19 =item Created
  20
  21 Thu Jan  5 11:06:49 PST 2006
  22
  23 =item Modified
  24
  25 $Date: 2013/02/21 05:01:17 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Simple date and time utilities for often used date/time functionality.
  32
  33   my $ymd = YMD;
  34   my $ymdhm = YMDHM;
  35   my $timestamp = timestamp;
  36
  37 =head1 DESCRIPTION
  38
  39 Often you just want to simply and quickly get date or date and time in
  40 a YMD or YMDHM format. Note the YMDHM format defined here is YMD\@H:M
  41 and is not well suited for a filename. The timestamp routine returns
  42 YMD_HM.
  43
  44 =head1 ROUTINES
  45
  46 The following routines are exported:
  47
  48 =cut
  49
  50 package DateUtils;
  51
  52 use strict;
  53 use warnings;
  54
  55 use base 'Exporter';
  56
  57 use Carp;
  58 use Time::Local;
  59
  60 use Display;
  61 use Utils;
  62
  63 our @EXPORT = qw (
  64   Add
  65   Age
  66   Compare
  67   DateToEpoch
  68   EpochToDate
  69   FormatDate
  70   FormatTime
  71   MDY
  72   SQLDatetime2UnixDatetime
  73   SubtractDays
  74   Today2SQLDatetime
  75   UnixDatetime2SQLDatetime
  76   UTCTime
  77   YMD
  78   YMDHM
  79   YMDHMS
  80   timestamp
  81   ymdhms
  82 );
  83
  84 my @months = (
  85   31, # January
  86   28, # February
  87   31, # March
  88   30, # April
  89   31, # May
  90   30, # June
  91   31, # July
  92   31, # August
  93   30, # September
  94   31, # October
  95   30, # November
  96   31  # Descember
  97 );
  98
  99 my $SECS_IN_MIN  = 60;
 100 my $SECS_IN_HOUR = $SECS_IN_MIN * 60;
 101 my $SECS_IN_DAY  = $SECS_IN_HOUR * 24;
 102
 103 # Forwards
 104 sub Today2SQLDatetime ();
 105 sub DateToEpoch ($);
 106 sub EpochToDate ($);
 107
 108 sub ymdhms {
 109   my ($time) = @_;
 110
 111   $time ||= time;
 112
 113   my (
 114     $sec,
 115     $min,
 116     $hour,
 117     $mday,
 118     $mon,
 119     $year,
 120     $wday,
 121     $yday,
 122     $isdst
 123   ) = localtime ($time);
 124
 125   # Adjust month
 126   $mon++;
 127
 128   # Adjust year
 129   $year += 1900;
 130
 131   # Zero preface month, day, hour and minute
 132   $mon  = '0' . $mon  if $mon  < 10;
 133   $mday = '0' . $mday if $mday < 10;
 134   $hour = '0' . $hour if $hour < 10;
 135   $min  = '0' . $min  if $min  < 10;
 136   $sec  = '0' . $sec  if $sec  < 10;
 137
 138   return $year, $mon, $mday, $hour, $min, $sec;
 139 } # ymdhms
 140
 141 sub julian ($$$) {
 142   my ($year, $month, $day) = @_;
 143
 144   my $days = 0;
 145   my $m    = 1;
 146
 147   foreach (@months) {
 148     last if $m >= $month;
 149     $m++;
 150     $days += $_;
 151   } # foreach
 152
 153   return $days + $day;
 154 } # julian
 155
 156 sub _is_leap_year ($) {
 157   my ($year) = @_;
 158
 159   return 0 if $year % 4;
 160   return 1 if $year % 100;
 161   return 0 if $year % 400;
 162
 163   return 1;
 164 } # _is_leap_year
 165
 166 sub Add ($%) {
 167   my ($datetime, %parms) = @_;
 168
 169 =pod
 170
 171 =head2 Add ($datetime, %parms)
 172
 173 Add to a datetime
 174
 175 Parameters:
 176
 177 =for html <blockquote>
 178
 179 =over
 180
 181 =item $datetime
 182
 183 Datetime in SQLDatetime format to manipulate.
 184
 185 =item %parms
 186
 187 Hash of parms. Acceptable values are of the following format:
 188
 189  seconds => $seconds
 190  minutes => $minutes
 191  hours   => $hours
 192  days    => $days
 193  month   => $month
 194
 195 Note that month will simply increment the month number, adjusting for overflow
 196 of year if appropriate. Therefore a date of 2/28/2001 would increase by 1 month
 197 to yield 3/28/2001. And, unfortunately, an increase of 1 month to 1/30/2011
 198 would incorrectly yeild 2/30/2011!
 199
 200 =back
 201
 202 =for html </blockquote>
 203
 204 Returns:
 205
 206 =for html <blockquote>
 207
 208 =over
 209
 210 =item New datetime
 211
 212 =back
 213
 214 =for html </blockquote>
 215
 216 =cut
 217
 218   my @validKeys = (
 219     'seconds',
 220     'minutes',
 221     'hours',
 222     'days',
 223     'months',
 224   );
 225
 226   foreach (keys %parms) {
 227     unless (InArray ($_, @validKeys)) {
 228       croak "Invalid key in DateUtils::Add: $_";
 229     } # unless
 230   } # foreach
 231
 232   my $epochTime = DateToEpoch $datetime;
 233
 234   my $amount = 0;
 235
 236   $parms{seconds} ||= 0;
 237   $parms{minutes} ||= 0;
 238   $parms{hours}   ||= 0;
 239   $parms{days}    ||= 0;
 240
 241   $amount += $parms{days}    * $SECS_IN_DAY;
 242   $amount += $parms{hours}   * $SECS_IN_HOUR;
 243   $amount += $parms{minutes} * $SECS_IN_MIN;
 244   $amount += $parms{seconds};
 245
 246   $epochTime += $amount;
 247
 248   $datetime = EpochToDate $epochTime;
 249
 250   if ($parms{month}) {
 251     my $years  = $parms{month} / 12;
 252     my $months = $parms{month} % 12;
 253
 254     my $month = substr $datetime, 5, 2;
 255
 256     $years += ($month + $months) / 12;
 257     substr ($datetime, 5, 2) = ($month + $months) % 12;
 258
 259     substr ($datetime, 0, 4) = substr ($datetime, 0, 4) + $years;
 260   } # if
 261
 262   return $datetime;
 263 } # Add
 264
 265 sub Age ($) {
 266   my ($timestamp) = @_;
 267
 268 =pod
 269
 270 =head2 Age ($timestamp)
 271
 272 Determines how old something is given a timestamp
 273
 274 Parameters:
 275
 276 =for html <blockquote>
 277
 278 =over
 279
 280 =item $timestamp:
 281
 282 Timestamp to age from (Assumed to be earlier than today)
 283
 284 =back
 285
 286 =for html </blockquote>
 287
 288 Returns:
 289
 290 =for html <blockquote>
 291
 292 =over
 293
 294 =item Number of days between $timestamp and today
 295
 296 =back
 297
 298 =for html </blockquote>
 299
 300 =cut
 301
 302   my $today      = Today2SQLDatetime;
 303   my $today_year = substr $today, 0, 4;
 304   my $month      = substr $today, 5, 2;
 305   my $day        = substr $today, 8, 2;
 306   my $today_days = julian $today_year, $month, $day;
 307
 308   my $timestamp_year = substr $timestamp, 0, 4;
 309   $month             = substr $timestamp, 5, 2;
 310   $day               = substr $timestamp, 8, 2;
 311   my $timestamp_days = julian $timestamp_year, $month, $day;
 312
 313   if ($timestamp_year > $today_year or
 314       ($timestamp_days > $today_days and $timestamp_year == $today_year)) {
 315     return;
 316   } else {
 317     my $leap_days = 0;
 318
 319     for (my $i = $timestamp_year; $i < $today_year; $i++) {
 320
 321       $leap_days++ if $i % 4 == 0;
 322     } # for
 323
 324     $today_days += 365 * ($today_year - $timestamp_year) + $leap_days;
 325     return $today_days - $timestamp_days;
 326   } # if
 327 } # Age
 328
 329 sub Compare ($$) {
 330   my ($date1, $date2) = @_;
 331
 332 =pod
 333
 334 =head2 Compare ($date2, $date2)
 335
 336 Compares two datetimes returning -1 if $date1 < $date2, 0 if equal or 1 if
 337 $date1 > $date2
 338
 339 Parameters:
 340
 341 =for html <blockquote>
 342
 343 =over
 344
 345 =item $date1
 346
 347 Date 1 to compare
 348
 349 =item $date2
 350
 351 Date 2 to compare
 352
 353 =back
 354
 355 =for html </blockquote>
 356
 357 Returns:
 358
 359 =for html <blockquote>
 360
 361 =over
 362
 363 =item -1 if $date1 < $date2, 0 if equal or 1 if $date1 > $date2
 364
 365 =back
 366
 367 =for html </blockquote>
 368
 369 =cut
 370
 371   return DateToEpoch ($date1) <=> DateToEpoch ($date2);
 372 } # Compare
 373
 374 sub DateToEpoch ($) {
 375   my ($date) = @_;
 376
 377 =pod
 378
 379 =head2 DateToEpoch ($datetime)
 380
 381 Converts a datetime to epoch
 382
 383 Parameters:
 384
 385 =for html <blockquote>
 386
 387 =over
 388
 389 =item $datetime
 390
 391 Datetime to convert to an epoch
 392
 393 =back
 394
 395 =for html </blockquote>
 396
 397 Returns:
 398
 399 =for html <blockquote>
 400
 401 =over
 402
 403 =item $epoch
 404
 405 =back
 406
 407 =for html </blockquote>
 408
 409 =cut
 410
 411   my $year    = substr $date,  0, 4;
 412   my $month   = substr $date,  5, 2;
 413   my $day     = substr $date,  8, 2;
 414   my $hour    = substr $date, 11, 2;
 415   my $minute  = substr $date, 14, 2;
 416   my $seconds = substr $date, 17, 2;
 417
 418   my $days;
 419
 420   for (my $i = 1970; $i < $year; $i++) {
 421     $days += _is_leap_year ($i) ? 366 : 365;
 422   } # for
 423
 424   my @monthDays = (
 425     0,
 426     31,
 427     59,
 428     90,
 429     120,
 430     151,
 431     181,
 432     212,
 433     243,
 434     273,
 435     304,
 436     334,
 437   );
 438
 439   $days += $monthDays[$month - 1];
 440
 441   $days++
 442     if _is_leap_year ($year) and $month > 2;
 443
 444  $days += $day - 1;
 445
 446   return ($days   * $SECS_IN_DAY)
 447        + ($hour   * $SECS_IN_HOUR)
 448        + ($minute * $SECS_IN_MIN)
 449        + $seconds;
 450 } # DateToEpoch
 451
 452 sub EpochToDate ($) {
 453   my ($epoch) = @_;
 454
 455 =pod
 456
 457 =head2 EpochToDate ($epoch)
 458
 459 Converts an epoch to a datetime
 460
 461 Parameters:
 462
 463 =for html <blockquote>
 464
 465 =over
 466
 467 =item $epoch
 468
 469 Epoch to convert to a datetime
 470
 471 =back
 472
 473 =for html </blockquote>
 474
 475 Returns:
 476
 477 =for html <blockquote>
 478
 479 =over
 480
 481 =item $datetime
 482
 483 =back
 484
 485 =for html </blockquote>
 486
 487 =cut
 488
 489   my $year = 1970;
 490   my ($month, $day, $hour, $minute, $seconds);
 491   my $leapYearSecs = 366 * $SECS_IN_DAY;
 492   my $yearSecs     = $leapYearSecs - $SECS_IN_DAY;
 493
 494   while () {
 495     my $amount = _is_leap_year ($year) ? $leapYearSecs : $yearSecs;
 496
 497     last
 498       if $amount > $epoch;
 499
 500     $epoch -= $amount;
 501     $year++;
 502   } # while
 503
 504   my $leapYearAdjustment = _is_leap_year ($year) ? 1 : 0;
 505
 506   if ($epoch >= (334 + $leapYearAdjustment) * $SECS_IN_DAY) {
 507     $month = '12';
 508     $epoch -= (334 + $leapYearAdjustment) * $SECS_IN_DAY;
 509   } elsif ($epoch >= (304 + $leapYearAdjustment) * $SECS_IN_DAY) {
 510     $month = '11';
 511     $epoch -= (304 + $leapYearAdjustment) * $SECS_IN_DAY;
 512   } elsif ($epoch >= (273 + $leapYearAdjustment) * $SECS_IN_DAY) {
 513     $month = '10';
 514     $epoch -= (273 + $leapYearAdjustment) * $SECS_IN_DAY;
 515   } elsif ($epoch >= (243 + $leapYearAdjustment) * $SECS_IN_DAY) {
 516     $month = '09';
 517     $epoch -= (243 + $leapYearAdjustment) * $SECS_IN_DAY;
 518   } elsif ($epoch >= (212 + $leapYearAdjustment) * $SECS_IN_DAY) {
 519     $month = '08';
 520     $epoch -= (212 + $leapYearAdjustment) * $SECS_IN_DAY;
 521   } elsif ($epoch >= (181 + $leapYearAdjustment) * $SECS_IN_DAY) {
 522     $month = '07';
 523     $epoch -= (181 + $leapYearAdjustment) * $SECS_IN_DAY;
 524   } elsif ($epoch >= (151 + $leapYearAdjustment) * $SECS_IN_DAY) {
 525     $month = '06';
 526     $epoch -= (151 + $leapYearAdjustment) * $SECS_IN_DAY;
 527   } elsif ($epoch >= (120 + $leapYearAdjustment) * $SECS_IN_DAY) {
 528     $month = '05';
 529     $epoch -= (120 + $leapYearAdjustment) * $SECS_IN_DAY;
 530   } elsif ($epoch >= (90 + $leapYearAdjustment) * $SECS_IN_DAY) {
 531     $month = '04';
 532     $epoch -= (90 + $leapYearAdjustment) * $SECS_IN_DAY;
 533   } elsif ($epoch >= (59 + $leapYearAdjustment) * $SECS_IN_DAY) {
 534     $month = '03';
 535     $epoch -= (59 + $leapYearAdjustment) * $SECS_IN_DAY;
 536   } elsif ($epoch >= 31 * $SECS_IN_DAY) {
 537     $month = '02';
 538     $epoch -= 31 * $SECS_IN_DAY;
 539   } else {
 540     $month = '01';
 541   } # if
 542
 543   $day     = int (($epoch / $SECS_IN_DAY) + 1);
 544   $epoch   = $epoch % $SECS_IN_DAY;
 545   $hour    = int ($epoch / $SECS_IN_HOUR);
 546   $epoch   = $epoch % $SECS_IN_HOUR;
 547   $minute  = int ($epoch / $SECS_IN_MIN);
 548   $seconds = $epoch % $SECS_IN_MIN;
 549
 550   $day     = "0$day"     if $day     < 10;
 551   $hour    = "0$hour"    if $hour    < 10;
 552   $minute  = "0$minute"  if $minute  < 10;
 553   $seconds = "0$seconds" if $seconds < 10;
 554
 555   return "$year-$month-$day $hour:$minute:$seconds";
 556 } # EpochToDate
 557
 558 sub UTCTime ($) {
 559   my ($datetime) = @_;
 560
 561 =pod
 562
 563 =head2 UTCTime ($epoch)
 564
 565 Converts an epoch to UTC Time
 566
 567 Parameters:
 568
 569 =for html <blockquote>
 570
 571 =over
 572
 573 =item $epoch
 574
 575 Epoch to convert to a datetime
 576
 577 =back
 578
 579 =for html </blockquote>
 580
 581 Returns:
 582
 583 =for html <blockquote>
 584
 585 =over
 586
 587 =item $datetime
 588
 589 =back
 590
 591 =for html </blockquote>
 592
 593 =cut
 594
 595   my @localtime = localtime;
 596   my ($sec, $min, $hour, $mday, $mon, $year) = gmtime (
 597     DateToEpoch ($datetime) - (timegm (@localtime) - timelocal (@localtime))
 598   );
 599
 600   $year += 1900;
 601   $mon++;
 602
 603   $sec  = '0' . $sec  if $sec  < 10;
 604   $min  = '0' . $min  if $min  < 10;
 605   $hour = '0' . $hour if $hour < 10;
 606   $mon  = '0' . $mon  if $mon  < 10;
 607   $mday = '0' . $mday if $mday < 10;
 608
 609   return "$year-$mon-${mday}T$hour:$min:${sec}Z";
 610 } # UTCTime
 611
 612 sub UTC2Localtime ($) {
 613   my ($utcdatetime) = @_;
 614
 615   # If the field does not look like a UTC time then just return it.
 616   return $utcdatetime unless $utcdatetime =~ /\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}Z/;
 617
 618   $utcdatetime =~ s/T/ /;
 619   $utcdatetime =~ s/Z//;
 620
 621   my @localtime = localtime;
 622
 623   return EpochToDate (
 624     DateToEpoch ($utcdatetime) + (timegm (@localtime) - timelocal (@localtime))
 625   );
 626 } # UTC2Localtime
 627
 628 sub FormatDate ($) {
 629   my ($date) = @_;
 630
 631 =pod
 632
 633 =head2 FormatDate ($date)
 634
 635 Formats date
 636
 637 Parameters:
 638
 639 =for html <blockquote>
 640
 641 =over
 642
 643 =item $date:
 644
 645 Date in YYYYMMDD
 646
 647 =back
 648
 649 =for html </blockquote>
 650
 651 Returns:
 652
 653 =for html <blockquote>
 654
 655 =over
 656
 657 =item Returns a date in MM/DD/YYYY format
 658
 659 =back
 660
 661 =for html </blockquote>
 662
 663 =cut
 664
 665   return substr ($date, 4, 2)
 666        . "/"
 667        . substr ($date, 6, 2)
 668        .  "/"
 669        . substr ($date, 0, 4);
 670 } # FormatDate
 671
 672 sub FormatTime ($) {
 673   my ($time) = @_;
 674
 675 =pod
 676
 677 =head2 FormatTime ($time)
 678
 679 Formats Time
 680
 681 Parameters:
 682
 683 =for html <blockquote>
 684
 685 =over
 686
 687 =item $time:
 688
 689 Time in in HH:MM format (24 hour format)
 690
 691 =back
 692
 693 =for html </blockquote>
 694
 695 Returns:
 696
 697 =for html <blockquote>
 698
 699 =over
 700
 701 =item Time in HH:MM [Am|Pm] format
 702
 703 =back
 704
 705 =for html </blockquote>
 706
 707 =cut
 708
 709   my $hours   = substr $time, 0, 2;
 710   my $minutes = substr $time, 3, 2;
 711   my $AmPm    = $hours > 12 ? "Pm" : "Am";
 712
 713   $hours = $hours - 12 if $hours > 12;
 714
 715   return "$hours:$minutes $AmPm";
 716 } # FormatTime
 717
 718 sub MDY (;$) {
 719   my ($time) = @_;
 720
 721 =pod
 722
 723 =head2 MDY ($time)
 724
 725 Returns MM/DD/YYYY for $time
 726
 727 Parameters:
 728
 729 =for html <blockquote>
 730
 731 =over
 732
 733 =item $time:
 734
 735 Time in Unix time format (Default: current time)
 736
 737 =back
 738
 739 =for html </blockquote>
 740
 741 Returns:
 742
 743 =for html <blockquote>
 744
 745 =over
 746
 747 =item Date in MM/DD/YYYY
 748
 749 =back
 750
 751 =for html </blockquote>
 752
 753 =cut
 754
 755   my ($year, $mon, $mday) = ymdhms $time;
 756
 757   return "$mon/$mday/$year";
 758 } # MDY
 759
 760 sub SQLDatetime2UnixDatetime ($) {
 761   my ($sqldatetime) = @_;
 762
 763 =pod
 764
 765 =head2 SQLDatetime2UnixDatetime ($sqldatetime)
 766
 767 Converts an SQL formatted date to a Unix (localtime) formatted date)
 768
 769 Parameters:
 770
 771 =for html <blockquote>
 772
 773 =over
 774
 775 =item $sqldatetime:
 776
 777 Date and time stamp in SQL format
 778
 779 =back
 780
 781 =for html </blockquote>
 782
 783 Returns:
 784
 785 =for html <blockquote>
 786
 787 =over
 788
 789 =item Returns a Unix formated date and time (a la localtime)
 790
 791 =back
 792
 793 =for html </blockquote>
 794
 795 =cut
 796
 797   my %months = (
 798     "01" => "Jan",
 799     "02" => "Feb",
 800     "03" => "Mar",
 801     "04" => "Apr",
 802     "05" => "May",
 803     "06" => "Jun",
 804     "07" => "Jul",
 805     "08" => "Aug",
 806     "09" => "Sep",
 807     "10" => "Oct",
 808     "11" => "Nov",
 809     "12" => "Dec"
 810   );
 811
 812   my $year  = substr $sqldatetime, 0, 4;
 813   my $month = substr $sqldatetime, 5, 2;
 814   my $day   = substr $sqldatetime, 8, 2;
 815   my $time  = FormatTime (substr $sqldatetime, 11);
 816
 817   return $months{$month} . " $day, $year \@ $time";
 818 } # SQLDatetime2UnixDatetime
 819
 820 sub SubtractDays ($$) {
 821   my ($timestamp, $nbr_of_days) = @_;
 822
 823 =pod
 824
 825 =head2 SubtractDays ($timestamp, $nbr_of_days)
 826
 827 Subtracts $nbr_of_days from $timestamp
 828
 829 Parameters:
 830
 831 =for html <blockquote>
 832
 833 =over
 834
 835 =item $timestamp:
 836
 837 Timestamp to subtract days from
 838
 839 =back
 840
 841 =over
 842
 843 =item $nbr_of_days:
 844
 845 =back
 846
 847 Number of days to subtract from $timestamp
 848
 849 =for html </blockquote>
 850
 851 Returns:
 852
 853 =for html <blockquote>
 854
 855 =over
 856
 857 =item SQL format date $nbr_of_days ago
 858
 859 =back
 860
 861 =for html </blockquote>
 862
 863 =cut
 864
 865   my $year  = substr $timestamp, 0, 4;
 866   my $month = substr $timestamp, 5, 2;
 867   my $day   = substr $timestamp, 8, 2;
 868
 869   # Convert to Julian
 870   my $days = julian $year, $month, $day;
 871
 872   # Subtract $nbr_of_days
 873   $days -= $nbr_of_days;
 874
 875   # Compute $days_in_year
 876   my $days_in_year;
 877
 878   # Adjust if crossing year boundary
 879   if ($days <= 0) {
 880     $year--;
 881     $days_in_year = (($year % 4) == 0) ? 366 : 365;
 882     $days = $days_in_year + $days;
 883   } else {
 884     $days_in_year = (($year % 4) == 0) ? 366 : 365;
 885   } # if
 886
 887   # Convert back
 888   $month = 0;
 889
 890   while ($days > 28) {
 891     # If remaining days is less than the current month then last
 892     last if ($days <= $months[$month]);
 893
 894     # Subtract off the number of days in this month
 895     $days -= $months[$month++];
 896   } # while
 897
 898   # Prefix month with 0 if necessary
 899   $month++;
 900   if ($month < 10) {
 901     $month = "0" . $month;
 902   } # if
 903
 904   # Prefix days with  0 if necessary
 905   if ($days == 0) {
 906     $days = "01";
 907   } elsif ($days < 10) {
 908     $days = "0" . $days;
 909   } # if
 910
 911   return $year . "-" . $month . "-" . $days . substr $timestamp, 10;
 912 } # SubtractDays
 913
 914 sub Today2SQLDatetime () {
 915
 916 =pod
 917
 918 =head2 Today2SQLDatetime ($datetime)
 919
 920 Returns today's date in an SQL format
 921
 922 Parameters:
 923
 924 =for html <blockquote>
 925
 926 =over
 927
 928 =item None
 929
 930 =back
 931
 932 =for html </blockquote>
 933
 934 Returns:
 935
 936 =for html <blockquote>
 937
 938 =over
 939
 940 =item SQL formated time stamp for today
 941
 942 =back
 943
 944 =for html </blockquote>
 945
 946 =cut
 947
 948   return UnixDatetime2SQLDatetime (scalar (localtime));
 949 } # Today2SQLDatetime
 950
 951 sub UnixDatetime2SQLDatetime ($) {
 952   my ($datetime) = @_;
 953
 954 =pod
 955
 956 =head2 UnixDatetime2SQLDatetime ($datetime)
 957
 958 Converts a Unix (localtime) date/time stamp to an SQL formatted
 959 date/time stamp
 960
 961 Parameters:
 962
 963 =for html <blockquote>
 964
 965 =over
 966
 967 =item $datetime:
 968
 969 Unix formated date time stamp
 970
 971 =back
 972
 973 =for html </blockquote>
 974
 975 Returns:
 976
 977 =for html <blockquote>
 978
 979 =over
 980
 981 =item SQL formated time stamp
 982
 983 =back
 984
 985 =for html </blockquote>
 986
 987 =cut
 988
 989   my $orig_datetime = $datetime;
 990   my %months = (
 991     Jan => '01',
 992     Feb => '02',
 993     Mar => '03',
 994     Apr => '04',
 995     May => '05',
 996     Jun => '06',
 997     Jul => '07',
 998     Aug => '08',
 999     Sep => '09',
1000     Oct => '10',
1001     Nov => '11',
1002     Dec => '12',
1003   );
1004
1005   # Some mailers neglect to put the leading day of the week field in.
1006   # Check for this and compensate.
1007   my $dow = substr $datetime, 0, 3;
1008
1009   if ($dow ne 'Mon' and
1010       $dow ne 'Tue' and
1011       $dow ne 'Wed' and
1012       $dow ne 'Thu' and
1013       $dow ne 'Fri' and
1014       $dow ne 'Sat' and
1015       $dow ne 'Sun') {
1016     $datetime = 'XXX, ' . $datetime;
1017   } # if
1018
1019   # Some mailers have day before month. We need to correct this
1020   my $day = substr $datetime, 5, 2;
1021
1022   if ($day =~ /\d /) {
1023     $day      = '0' . (substr $day, 0, 1);
1024     $datetime = (substr $datetime, 0, 5) . $day . (substr $datetime, 6);
1025   } # if
1026
1027   if ($day !~ /\d\d/) {
1028     $day = substr $datetime, 8, 2;
1029   } # if
1030
1031   # Check for 1 digit date
1032   if ((substr $day, 0, 1) eq ' ') {
1033     $day      = '0' . (substr $day, 1, 1);
1034     $datetime = (substr $datetime, 0, 8) . $day . (substr $datetime, 10);
1035   } elsif ((substr $day, 1, 1) eq ' ') {
1036     $day      = '0' . (substr $day, 0, 1);
1037     $datetime = (substr $datetime, 0, 8) . $day . (substr $datetime, 9);
1038   } # if
1039
1040   my $year = substr $datetime, 20, 4;
1041
1042   if ($year !~ /\d\d\d\d/) {
1043     $year = substr $datetime, 12, 4;
1044     if ($year !~ /\d\d\d\d/) {
1045       $year = substr $datetime, 12, 2;
1046     } #if
1047   } # if
1048
1049   # Check for 2 digit year. Argh!
1050   if (length $year == 2 or (substr $year, 2, 1) eq ' ') {
1051     $year     = '20' . (substr $year, 0, 2);
1052     $datetime = (substr $datetime, 0, 12) . '20' . (substr $datetime, 12);
1053   } # if
1054
1055   my $month_name = substr $datetime, 4, 3;
1056
1057   unless ($months{$month_name}) {
1058     $month_name = substr $datetime, 8, 3;
1059   } # unless
1060
1061   my $month = $months{$month_name};
1062   my $time  = substr $datetime, 11, 8;
1063
1064   if ($time !~ /\d\d:\d\d:\d\d/) {
1065     $time = substr $datetime, 17, 8
1066   } # if
1067
1068   unless ($year) {
1069     warning "Year undefined for $orig_datetime\nReturning today's date";
1070     return Today2SQLDatetime;
1071   } # unless
1072
1073   unless ($month) {
1074     warning "Month undefined for $orig_datetime\nReturning today's date";
1075     return Today2SQLDatetime;
1076   } # unless
1077
1078   unless ($day) {
1079     warning "Day undefined for $orig_datetime\nReturning today's date";
1080     return Today2SQLDatetime;
1081   } # unless
1082
1083   unless ($time) {
1084     warning "Time undefined for $orig_datetime\nReturning today's date";
1085     return Today2SQLDatetime;
1086   } # unless
1087
1088   return "$year-$month-$day $time";
1089 } # UnixDatetime2SQLDatetime
1090
1091 sub YMD (;$) {
1092   my ($time) = @_;
1093
1094 =pod
1095
1096 =head2 YMD ($time)
1097
1098 Returns the YMD in a format of YYYYMMDD
1099
1100 Parameters:
1101
1102 =for html <blockquote>
1103
1104 =over
1105
1106 =item $time:
1107
1108 Time to convert to YYYYMMDD (Default: Current time)
1109
1110 =back
1111
1112 =for html </blockquote>
1113
1114 Returns:
1115
1116 =for html <blockquote>
1117
1118 =over
1119
1120 =item Date in YYYYMMDD format
1121
1122 =back
1123
1124 =for html </blockquote>
1125
1126 =cut
1127
1128   my ($year, $mon, $mday) = ymdhms $time;
1129
1130   return "$year$mon$mday";
1131 } # YMD
1132
1133 sub YMDHM (;$) {
1134   my ($time) = @_;
1135
1136 =pod
1137
1138 =head2 YMDHM ($time)
1139
1140 Returns the YMD in a format of YYYYMMDD@HH:MM
1141
1142 Parameters:
1143
1144 =for html <blockquote>
1145
1146 =over
1147
1148 =item $time:
1149
1150 Time to convert to YYYYMMDD@HH:MM (Default: Current time)
1151
1152 =back
1153
1154 =for html </blockquote>
1155
1156 Returns:
1157
1158 =for html <blockquote>
1159
1160 =over
1161
1162 =item Date in YYYYMMDD@HH:MM format
1163
1164 =back
1165
1166 =for html </blockquote>
1167
1168 =cut
1169
1170   my ($year, $mon, $mday, $hour, $min) = ymdhms $time;
1171
1172   return "$year$mon$mday\@$hour:$min";
1173 } # YMDHM
1174
1175 sub YMDHMS (;$) {
1176   my ($time) = @_;
1177
1178 =pod
1179
1180 =head2 YMDHMS ($time)
1181
1182 Returns the YMD in a format of YYYYMMDD@HH:MM:SS
1183
1184 Parameters:
1185
1186 =for html <blockquote>
1187
1188 =over
1189
1190 =item $time:
1191
1192 Time to convert to YYYYMMDD@HH:MM:SS (Default: Current time)
1193
1194 =back
1195
1196 =for html </blockquote>
1197
1198 Returns:
1199
1200 =for html <blockquote>
1201
1202 =over
1203
1204 =item Date in YYYYMMDD@HH:MM:SS format
1205
1206 =back
1207
1208 =for html </blockquote>
1209
1210 =cut
1211
1212   my ($year, $mon, $mday, $hour, $min, $sec) = ymdhms $time;
1213
1214   return "$year$mon$mday\@$hour:$min:$sec";
1215 } # YMDHMS
1216
1217 sub timestamp (;$) {
1218   my ($time) = @_;
1219
1220 =pod
1221
1222 =head2 timestamp ($time)
1223
1224 Returns the YMD in a format of YYYYMMDD_HHMM
1225
1226 Parameters:
1227
1228 =for html <blockquote>
1229
1230 =over
1231
1232 =item $time:
1233
1234 Time to convert to YYYYMMDD_HHMMSS (Default: Current time)
1235
1236 =for html </blockquote>
1237
1238 Returns:
1239
1240 =for html <blockquote>
1241
1242 =over
1243
1244 =item Date in YYYYMMDD_HHMMSS format
1245
1246 =back
1247
1248 =for html </blockquote>
1249
1250 =cut
1251
1252   my ($year, $mon, $mday, $hour, $min, $sec) = ymdhms $time;
1253
1254   return "$year$mon${mday}_$hour$min$sec";
1255 } # timestamp
1256
1257 1;
1258
1259 =head2 DEPENDENCIES
1260
1261 =head3 Perl Modules
1262
1263 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
1264
1265 =head1 INCOMPATABILITIES
1266
1267 None yet...
1268
1269 =head1 BUGS AND LIMITATIONS
1270
1271 There are no known bugs in this module.
1272
1273 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1274
1275 =head1 LICENSE AND COPYRIGHT
1276
1277 This Perl Module is freely available; you can redistribute it and/or
1278 modify it under the terms of the GNU General Public License as
1279 published by the Free Software Foundation; either version 2 of the
1280 License, or (at your option) any later version.
1281
1282 This Perl Module is distributed in the hope that it will be useful,
1283 but WITHOUT ANY WARRANTY; without even the implied warranty of
1284 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1285 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
1286 details.
1287
1288 You should have received a copy of the GNU General Public License
1289 along with this Perl Module; if not, write to the Free Software Foundation,
1290 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1291 reserved.
1292
1293 =cut