"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/AbsenceDate.pm" (20 Oct 2013, 6600 Bytes) of package /linux/www/web-absence-2.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "AbsenceDate.pm" see the Fossies "Dox" file reference documentation.

    1 #======================================================================
    2 #    This file is part of Absence.
    3 #
    4 #    Absence is free software: you can redistribute it and/or modify
    5 #    it under the terms of the GNU General Public License as published by
    6 #    the Free Software Foundation, either version 3 of the License, or
    7 #    (at your option) any later version.
    8 #
    9 #    Absence is distributed in the hope that it will be useful,
   10 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
   11 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   12 #    GNU General Public License for more details.
   13 #
   14 #    You should have received a copy of the GNU General Public License
   15 #    along with Absence.  If not, see <http://www.gnu.org/licenses/>.
   16 #======================================================================
   17 
   18 package AbsenceDate;
   19 
   20 # $Id: AbsenceDate.pm 111 2013-10-20 17:57:24Z urban $
   21 # copyright Robert Urban
   22 
   23 use Time::Local;
   24 use POSIX qw(strftime);
   25 
   26 my @WEEKDAYS    = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
   27 my $VERSION     = '2.0.1';
   28 
   29 #----------------------------------------------------------------------
   30 # daysInMonth()
   31 #
   32 # $monthnum has format 1-12
   33 #----------------------------------------------------------------------
   34 
   35 sub daysInMonth
   36 {
   37     my ($monthnum, $year) = @_;
   38 
   39     $monthnum--;
   40     my @daysinmonth = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
   41 
   42     if ($monthnum == 1) {
   43         # February
   44         return isLeapYear($year) ? 29 : 28;
   45     } else {
   46         return $daysinmonth[$monthnum];
   47     }
   48 }
   49 
   50 sub weekDayFromDate
   51 {
   52     my ($day, $month, $year, $parm) = @_;
   53 
   54     ($day > 31) && die "impossible day: [$day]";
   55 
   56     my $time = timelocal(0, 0, 0, $day, $month - 1, $year - 1900);
   57 
   58     my $wd = (localtime($time))[6];
   59 
   60     if ($parm eq '-name') {
   61         return $WEEKDAYS[$wd];
   62     }
   63 
   64     return $wd;
   65 }
   66 
   67 sub isLeapYear
   68 {
   69     my $year = shift;
   70 
   71     return (($year % 4 == 0) xor ($year % 100 == 0) xor ($year % 400 == 0));
   72 }
   73 
   74 sub yearDay
   75 {
   76     my ($day, $month, $year) = @_;
   77 
   78     my $time = timelocal(0, 0, 0, $day, $month - 1, $year - 1900);
   79     return (localtime($time))[7] + 1;
   80 }
   81 
   82 ## sub yearDay
   83 ## {
   84 ##  my ($day, $month, $year) = @_;
   85 ## 
   86 ##  my $month_num = 1;
   87 ##  my $total = 0;
   88 ##  while($month_num < $month) {
   89 ##      $total += daysInMonth($month_num);
   90 ##      $month_num++;
   91 ##  }
   92 ##  $total += $day;
   93 ## 
   94 ##  $total;
   95 ## }
   96 
   97 #----------------------------------------------------------------------
   98 # monthName()
   99 #
  100 # takes month number in range 1 - 12
  101 #----------------------------------------------------------------------
  102 sub monthName
  103 {
  104     my ($month_num, $parm) = @_;
  105 
  106     $month_num--;
  107 
  108     my @months = qw(January February March April May June
  109         July August September October November December);
  110 
  111     if ($parm eq '-short') {
  112         return substr($months[$month_num], 0, 3);
  113     }
  114 
  115     return $months[$month_num];
  116 }
  117 
  118 #----------------------------------------------------------------------
  119 #----------------------------------------------------------------------
  120 #----------------------------------------------------------------------
  121 
  122 #----------------------------------------------------------------------
  123 # julianDay()
  124 #
  125 # calculates the Julian Day, as described in the "Calendar FAQ"
  126 # (http://www.pauahtun.org/CalendarFAQ/cal/calendar24.html, section 2.15.1)
  127 #
  128 #----------------------------------------------------------------------
  129 
  130 sub julianDay
  131 {
  132     #my ($day, $month, $year) = @_;
  133     my $ref = shift;
  134 
  135     use integer;
  136     my ($a, $y, $m);
  137     $a = (14 - $ref->{month})/12;
  138     $y = $ref->{year} + 4800 - $a;
  139     $m = $ref->{month} + 12 * $a - 3;
  140 
  141     my $jd = $ref->{day} + (153 * $m + 2)/5 + 365 * $y + $y/4
  142         - $y/100 + $y/400 - 32045;
  143 
  144     return $jd;
  145 }
  146 
  147 sub julianToGregorian
  148 {
  149     my $jd = shift;
  150 
  151     my ($a, $b, $c, $d, $e, $m, $day, $month, $year);
  152 
  153     use integer;
  154     $a = $jd + 32044;
  155     $b = (4 * $a + 3) / 146097;
  156     $c = $a - (146097 * $b) / 4;
  157     $d = (4 * $c + 3)/1461;
  158     $e = $c - (1461 * $d) / 4;
  159     $m = (5 * $e + 2) / 153;
  160 
  161     $day = $e - (153 * $m + 2) / 5 + 1;
  162     $month = $m + 3 - 12 * ($m / 10);
  163     $year = 100 * $b + $d - 4800 + $m / 10;
  164 
  165     return ($day, $month, $year);
  166 }
  167 
  168 ##################################
  169 # Gregorian Date from Julian Day #
  170 ##################################
  171 sub julianToGregorian2 {
  172     my $jd = shift;
  173 
  174     use integer;
  175     my ($d,$i,$j,$l,$m,$n,$y);
  176     $l = $jd + 68569;
  177     $n = ( 4 * $l ) / 146097;
  178     $l = $l - ( 146097 * $n + 3 ) / 4;
  179     $i = ( 4000 * ( $l + 1 ) ) / 1461001;
  180     $l = $l - ( 1461 * $i ) / 4 + 31;
  181     $j = ( 80 * $l ) / 2447;
  182     $d = $l - ( 2447 * $j ) / 80;
  183     $l = $j / 11;
  184     $m = $j + 2 - ( 12 * $l );
  185     $y = 100 * ( $n - 49 ) + $i + $l;
  186     return ($d, $m, $y);
  187 };
  188 #----------------------------------------------------------------------
  189 # calendarWeek()
  190 #
  191 # calculates the calendar week, as described in the "Calendar FAQ"
  192 # (http://www.pauahtun.org/CalendarFAQ/cal/calendar24.html, section 5.8)
  193 #
  194 # returns an array consisting of calendar-week and year, where year
  195 # is the year in which the calendar-week actually falls
  196 #----------------------------------------------------------------------
  197 
  198 sub calendarWeek
  199 {
  200     my ($day, $month, $year) = @_;
  201 
  202     my $jd = julianDay($day, $month, $year);
  203 
  204     use integer;
  205     my($d1, $d4, $l);
  206 
  207     $d4 = ($jd + 31741 - ($jd % 7)) % 146097 % 36524 % 1461;
  208     $l = $d4/1460;
  209     $d1 = (($d4 - $l) % 365) + $l;
  210 
  211     my $cw = $d1/7 + 1;
  212 
  213     if (($month == 1) && ($cw > 51)) { $year--; }
  214     elsif (($month == 12) && ($cw == 1)) { $year++; }
  215 
  216     return ($cw, $year);
  217 }
  218 
  219 1;
  220 
  221 __END__
  222 
  223 =head1 NAME
  224 
  225 AbsenceDate.pm - date functions needed by absence
  226 
  227 =head1 SYNOPSIS
  228 
  229 use AbsenceDate;
  230 
  231 $julian_day = julianDay($day, $month, $year);
  232 $days_in_month = daysInMonth($month_number, $year);
  233 $week_day = weekDayFromDate($day, $month, $year, $option);
  234 $month_name = monthName($month_number, $option);
  235 $cw = calendarWeek($day, $month, $year);
  236 
  237 =head1 DESCRIPTION
  238 
  239 AbsenceDate.pm contains basic date-manipulation routines.
  240 
  241 =head1 FUNCTIONS
  242 
  243 =over 4
  244 
  245 =item julianDay()
  246 
  247 returns the "julian day", (days are numbered over many years).  This
  248 allows simple comparions of dates without fumbling about with
  249 days, months, and years.  Parameters are (day, month, year).
  250 
  251 =item daysInMonth()
  252 
  253 given a month and year, returns the number of days in that month.
  254 
  255 =item weekDayFromDate();
  256 
  257 returns the weekday-number for a particular date.  If C<$option>
  258 is '-name', returns the name of the day instead of the number.
  259 
  260 =item monthName()
  261 
  262 given a month-number between 1 and 12, returns the name of the
  263 month.  if C<$option> equals '-short', returns the first three
  264 letters of the name.
  265 
  266 =item calendarWeek()
  267 
  268 returns the calendar-week in which a particular date falls.
  269 
  270 =back
  271 
  272 =head1 AUTHOR
  273 
  274 Robert Urban <urban@tru64.org>
  275 
  276 Copyright (C) 2003 Robert Urban
  277 
  278 =cut