############################################################################### ## ## ## Copyright (c) 1995 - 2015 by Steffen Beyer. ## ## All rights reserved. ## ## ## ## This package is free software; you can redistribute it ## ## and/or modify it under the same terms as Perl itself. ## ## ## ############################################################################### package Date::Calc::PP; BEGIN { eval { require bytes; }; } use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); use Carp::Clan qw(^Date::); use POSIX (); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw( Days_in_Year Days_in_Month Weeks_in_Year leap_year check_date check_time check_business_date Day_of_Year Date_to_Days Day_of_Week Week_Number Week_of_Year Monday_of_Week Nth_Weekday_of_Month_Year Standard_to_Business Business_to_Standard Delta_Days Delta_DHMS Delta_YMD Delta_YMDHMS N_Delta_YMD N_Delta_YMDHMS Normalize_DHMS Add_Delta_Days Add_Delta_DHMS Add_Delta_YM Add_Delta_YMD Add_Delta_YMDHMS Add_N_Delta_YMD Add_N_Delta_YMDHMS System_Clock Today Now Today_and_Now This_Year Gmtime Localtime Mktime Timezone Date_to_Time Time_to_Date Easter_Sunday Decode_Month Decode_Day_of_Week Decode_Language Decode_Date_EU Decode_Date_US Fixed_Window Moving_Window Compress Uncompress check_compressed Compressed_to_Text Date_to_Text Date_to_Text_Long English_Ordinal Calendar Month_to_Text Day_of_Week_to_Text Day_of_Week_Abbreviation Language_to_Text Language Languages Decode_Date_EU2 Decode_Date_US2 Parse_Date ISO_LC ISO_UC ); %EXPORT_TAGS = (all => [@EXPORT_OK]); ################################################## ## ## ## "Version()" is available but not exported ## ## in order to avoid possible name clashes. ## ## Call "Date::Calc::PP::Version()" instead! ## ## ## ################################################## $VERSION = '6.4'; sub Version { return $VERSION; } ################# ## ## ## Resources ## ## ## ################# my $DateCalc_YEAR_OF_EPOCH = 70; # year of reference (epoch) my $DateCalc_CENTURY_OF_EPOCH = 1900; # century of reference (epoch) my $DateCalc_EPOCH = $DateCalc_CENTURY_OF_EPOCH + $DateCalc_YEAR_OF_EPOCH; my $DateCalc_DAYS_TO_EPOCH; my $DateCalc_DAYS_TO_OVFLW; my $DateCalc_SECS_TO_OVFLW; ## MacOS (Classic): ## ## <695056.0> = Fri 1-Jan-1904 00:00:00 (time=0x00000000) ## ## <744766.23295> = Mon 6-Feb-2040 06:28:15 (time=0xFFFFFFFF) ## ## Unix: ## ## <719163.0> = Thu 1-Jan-1970 00:00:00 (time=0x00000000) ## ## <744018.11647> = Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) ## if ($^O eq 'MacOS') { $DateCalc_DAYS_TO_EPOCH = 695056; $DateCalc_DAYS_TO_OVFLW = 744766; $DateCalc_SECS_TO_OVFLW = 23295; } else { $DateCalc_DAYS_TO_EPOCH = 719163; $DateCalc_DAYS_TO_OVFLW = 744018; $DateCalc_SECS_TO_OVFLW = 11647; } my(@DateCalc_Days_in_Year_) = ( [ 0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 ], [ 0, 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 ] ); my(@DateCalc_Days_in_Month_) = ( [ 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ], [ 0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ] ); my $DateCalc_LANGUAGES = 14; my $DateCalc_Language = 1; # Default = 1 (English) my(@DateCalc_Month_to_Text_) = ( [ "???", "???", "???", "???", "???", "???", "???", "???", "???", "???", "???", "???", "???" ], [ "???", "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December" ], [ "???", "janvier", "février", "mars", "avril", "mai", "juin", "juillet", "aoűt", "septembre", "octobre", "novembre", "décembre" ], [ "???", "Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember" ], [ "???", "enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre" ], [ "???", "janeiro", "fevereiro", "março", "abril", "maio", "junho", "julho", "agosto", "setembro", "outubro", "novembro", "dezembro" ], [ "???", "januari", "februari", "maart", "april", "mei", "juni", "juli", "augustus", "september", "oktober", "november", "december" ], [ "???", "Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre" ], [ "???", "januar", "februar", "mars", "april", "mai", "juni", "juli", "august", "september", "oktober", "november", "desember" ], [ "???", "januari", "februari", "mars", "april", "maj", "juni", "juli", "augusti", "september", "oktober", "november", "december" ], [ "???", "januar", "februar", "marts", "april", "maj", "juni", "juli", "august", "september", "oktober", "november", "december" ], [ "???", "tammikuu", "helmikuu", "maaliskuu", "huhtikuu", "toukokuu", "kesäkuu", "heinäkuu", "elokuu", "syyskuu", "lokakuu", "marraskuu", "joulukuu" ], [ "???", "Január", "Február", "Március", "Április", "Május", "Június", "Július", "Augusztus", "Szeptember", "Október", "November", "December" ], [ "???", "Styczen", "Luty", "Marzec", "Kwiecien", "Maj", "Czerwiec", # ISO-Latin-1 approximation "Lipiec", "Sierpien", "Wrzesien", "Pazdziernik", "Listopad", "Grudzien" ], [ "???", "Ianuarie", "Februarie", "Martie", "Aprilie", "Mai", "Iunie", "Iulie", "August", "Septembrie", "Octombrie", "Noiembrie", "Decembrie" ] ); my(@DateCalc_Day_of_Week_to_Text_) = ( [ "???", "???", "???", "???", "???", "???", "???", "???" ], [ "???", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday" ], [ "???", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche" ], [ "???", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag" ], [ "???", "Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Domingo" ], [ "???", "Segunda-feira", "Terça-feira", "Quarta-feira", "Quinta-feira", "Sexta-feira", "Sábado", "Domingo" ], [ "???", "Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrijdag", "Zaterdag", "Zondag" ], [ "???", "Lunedě", "Martedě", "Mercoledě", "Giovedě", "Venerdě", "Sabato", "Domenica" ], [ "???", "mandag", "tirsdag", "onsdag", "torsdag", "fredag", "lřrdag", "sřndag" ], [ "???", "mĺndag", "tisdag", "onsdag", "torsdag", "fredag", "lördag", "söndag" ], [ "???", "mandag", "tirsdag", "onsdag", "torsdag", "fredag", "lřrdag", "sřndag" ], [ "???", "maanantai", "tiistai", "keskiviikko", "torstai", "perjantai", "lauantai", "sunnuntai" ], [ "???", "hétfő", "kedd", "szerda", "csütörtök", "péntek", "szombat", "vasárnap" ], [ "???", "poniedzialek", "wtorek", "sroda", # ISO-Latin-1 approximation "czwartek", "piatek", "sobota", "niedziela" ], [ "???", "Luni", "Marti", "Miercuri", "Joi", "Vineri", "Sambata", "Duminica" ] ); my(@DateCalc_Day_of_Week_Abbreviation_) = ( # Fill the fields below _only_ if special abbreviations are needed! # Note that the first field serves as a flag and must be non-empty! [ "", "", "", "", "", "", "", "" # 0 # ], [ "", "", "", "", "", "", "", "" # 1 # ], [ "", "", "", "", "", "", "", "" # 2 # ], [ "", "", "", "", "", "", "", "" # 3 # ], [ "", "", "", "", "", "", "", "" # 4 # ], [ "", "", "", "", "", "", "", "" # 5 # # "???", "2Ş", "3Ş", "4Ş", "5Ş", "6Ş", "Sáb", "Dom" # 5 # ], [ "", "", "", "", "", "", "", "" # 6 # ], [ "", "", "", "", "", "", "", "" # 7 # ], [ "", "", "", "", "", "", "", "" # 8 # ], [ "", "", "", "", "", "", "", "" # 9 # ], [ "", "", "", "", "", "", "", "" # 10 # ], [ "", "", "", "", "", "", "", "" # 11 # ], [ "", "", "", "", "", "", "", "" # 12 # ], [ "???", "Pn", "Wt", "Sr", "Cz", "Pt", "So", "Ni" # 13 # ISO-Latin-1 approximation ], [ "", "", "", "", "", "", "", "" # 14 # ] ); my(@DateCalc_English_Ordinals_) = ( "th", "st", "nd", "rd" ); my(@DateCalc_Date_Long_Format_) = ( "%s, %d %s %d", # 0 Default # "%s, %s %s %d", # 1 English # "%s %d %s %d", # 2 Français # "%s, den %d. %s %d", # 3 Deutsch # "%s, %d de %s de %d", # 4 Espańol # "%s, dia %d de %s de %d", # 5 Portuguęs # "%s, %d %s %d", # 6 Nederlands # "%s, %d %s %d", # 7 Italiano # "%s, %d. %s %d", # 8 Norsk # "%s, %d %s %d", # 9 Svenska # "%s, %d. %s %d", # 10 Dansk # "%s, %d. %sta %d", # 11 suomi # "%d. %s %d., %s", # 12 Magyar # "%s, %d %s %d", # 13 polski # "%s %d %s %d" # 14 Romaneste # ); my(@DateCalc_Language_to_Text_) = ( "???", "English", "Français", "Deutsch", "Espańol", "Portuguęs", "Nederlands", "Italiano", "Norsk", "Svenska", "Dansk", "suomi", "Magyar", "polski", "Romaneste" ); ############### ## ## ## Calc.xs ## ## ## ############### ############################################################################### ## ## ## Copyright (c) 1995 - 2015 by Steffen Beyer. ## ## All rights reserved. ## ## ## ## This package is free software; you can redistribute it ## ## and/or modify it under the same terms as Perl itself. ## ## ## ############################################################################### sub DATECALC_USAGE { croak('Usage: Date::Calc::' . $_[0]); } sub DATECALC_ERROR { croak("Date::Calc::$_[0](): $_[1]"); } sub DATECALC_DATE_ERROR { croak("Date::Calc::$_[0](): not a valid date"); } sub DATECALC_TIME_ERROR { croak("Date::Calc::$_[0](): not a valid time"); } sub DATECALC_YEAR_ERROR { croak("Date::Calc::$_[0](): year out of range"); } sub DATECALC_MONTH_ERROR { croak("Date::Calc::$_[0](): month out of range"); } sub DATECALC_WEEK_ERROR { croak("Date::Calc::$_[0](): week out of range"); } sub DATECALC_DAYOFWEEK_ERROR { croak("Date::Calc::$_[0](): day of week out of range"); } sub DATECALC_DATE_RANGE_ERROR { croak("Date::Calc::$_[0](): date out of range"); } sub DATECALC_TIME_RANGE_ERROR { croak("Date::Calc::$_[0](): time out of range"); } sub DATECALC_FACTOR_ERROR { croak("Date::Calc::$_[0](): factor out of range"); } sub DATECALC_LANGUAGE_ERROR { croak("Date::Calc::$_[0](): language not available"); } sub DATECALC_SYSTEM_ERROR { croak("Date::Calc::$_[0](): not available on this system"); } sub DATECALC_MEMORY_ERROR { croak("Date::Calc::$_[0](): unable to allocate memory"); } sub DATECALC_STRING_ERROR { croak("Date::Calc::$_[0](): argument is not a string"); } sub DATECALC_SCALAR_ERROR { croak("Date::Calc::$_[0](): argument is not a scalar"); } sub Days_in_Year { DATECALC_USAGE('Days_in_Year($year,$month)') unless (@_ == 2); my($year,$month) = @_; if ($year > 0) { if (($month >= 1) and ($month <= 12)) { return $DateCalc_Days_in_Year_[DateCalc_leap_year($year)][$month+1]; } else { DATECALC_MONTH_ERROR('Days_in_Year'); } } else { DATECALC_YEAR_ERROR('Days_in_Year'); } } sub Days_in_Month { DATECALC_USAGE('Days_in_Month($year,$month)') unless (@_ == 2); my($year,$month) = @_; if ($year > 0) { if (($month >= 1) and ($month <= 12)) { return $DateCalc_Days_in_Month_[DateCalc_leap_year($year)][$month]; } else { DATECALC_MONTH_ERROR('Days_in_Month'); } } else { DATECALC_YEAR_ERROR('Days_in_Month'); } } sub Weeks_in_Year { DATECALC_USAGE('Weeks_in_Year($year)') unless (@_ == 1); my($year) = shift; if ($year > 0) { return DateCalc_Weeks_in_Year($year); } else { DATECALC_YEAR_ERROR('Weeks_in_Year'); } } sub leap_year { DATECALC_USAGE('leap_year($year)') unless (@_ == 1); my($year) = shift; if ($year > 0) { return DateCalc_leap_year($year); } else { DATECALC_YEAR_ERROR('leap_year'); } } sub check_date { DATECALC_USAGE('check_date($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; return DateCalc_check_date($year,$month,$day); } sub check_time { DATECALC_USAGE('check_time($hour,$min,$sec)') unless (@_ == 3); my($hour,$min,$sec) = @_; return DateCalc_check_time($hour,$min,$sec); } sub check_business_date { DATECALC_USAGE('check_business_date($year,$week,$dow)') unless (@_ == 3); my($year,$week,$dow) = @_; return DateCalc_check_business_date($year,$week,$dow); } sub Day_of_Year { DATECALC_USAGE('Day_of_Year($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; my $retval = DateCalc_Day_of_Year($year,$month,$day); if ($retval == 0) { DATECALC_DATE_ERROR('Day_of_Year'); } return $retval; } sub Date_to_Days { DATECALC_USAGE('Date_to_Days($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; my $retval = DateCalc_Date_to_Days($year,$month,$day); if ($retval == 0) { DATECALC_DATE_ERROR('Date_to_Days'); } return $retval; } sub Day_of_Week { DATECALC_USAGE('Day_of_Week($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; my $retval = DateCalc_Day_of_Week($year,$month,$day); if ($retval == 0) { DATECALC_DATE_ERROR('Day_of_Week'); } return $retval; } sub Week_Number { DATECALC_USAGE('Week_Number($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; my($retval); if (DateCalc_check_date($year,$month,$day)) { $retval = DateCalc_Week_Number($year,$month,$day); } else { DATECALC_DATE_ERROR('Week_Number'); } return $retval; } sub Week_of_Year { DATECALC_USAGE('Week_of_Year($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; my($week); if (DateCalc_week_of_year(\$week,\$year,$month,$day)) { if (wantarray) { return($week,$year); } else { return $week; } } else { DATECALC_DATE_ERROR('Week_of_Year'); } } sub Monday_of_Week { DATECALC_USAGE('Monday_of_Week($week,$year)') unless (@_ == 2); my($week,$year) = @_; my($month,$day); if ($year > 0) { if (($week > 0) and ($week <= DateCalc_Weeks_in_Year($year))) { if (DateCalc_monday_of_week($week,\$year,\$month,\$day)) { return($year,$month,$day); } else { DATECALC_DATE_ERROR('Monday_of_Week'); } } else { DATECALC_WEEK_ERROR('Monday_of_Week'); } } else { DATECALC_YEAR_ERROR('Monday_of_Week'); } } sub Nth_Weekday_of_Month_Year { DATECALC_USAGE('Nth_Weekday_of_Month_Year($year,$month,$dow,$n)') unless (@_ == 4); my($year,$month,$dow,$n) = @_; my($day); if ($year > 0) { if (($month >= 1) and ($month <= 12)) { if (($dow >= 1) and ($dow <= 7)) { if (($n >= 1) and ($n <= 5)) { if (DateCalc_nth_weekday_of_month_year(\$year,\$month,\$day,$dow,$n)) { return($year,$month,$day); } else { return(); } } else { DATECALC_FACTOR_ERROR('Nth_Weekday_of_Month_Year'); } } else { DATECALC_DAYOFWEEK_ERROR('Nth_Weekday_of_Month_Year'); } } else { DATECALC_MONTH_ERROR('Nth_Weekday_of_Month_Year'); } } else { DATECALC_YEAR_ERROR('Nth_Weekday_of_Month_Year'); } } sub Standard_to_Business { DATECALC_USAGE('Standard_to_Business($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; my($week,$dow); if (DateCalc_standard_to_business(\$year,\$week,\$dow,$month,$day)) { return($year,$week,$dow); } else { DATECALC_DATE_ERROR('Standard_to_Business'); } } sub Business_to_Standard { DATECALC_USAGE('Business_to_Standard($year,$week,$dow)') unless (@_ == 3); my($year,$week,$dow) = @_; my($month,$day); if (DateCalc_business_to_standard(\$year,\$month,\$day,$week,$dow)) { return($year,$month,$day); } else { DATECALC_DATE_ERROR('Business_to_Standard'); } } sub Delta_Days { DATECALC_USAGE('Delta_Days($year1,$month1,$day1,$year2,$month2,$day2)') unless (@_ == 6); my($year1,$month1,$day1,$year2,$month2,$day2) = @_; my($retval); if (DateCalc_check_date($year1,$month1,$day1) and DateCalc_check_date($year2,$month2,$day2)) { $retval = DateCalc_Delta_Days($year1,$month1,$day1, $year2,$month2,$day2); } else { DATECALC_DATE_ERROR('Delta_Days'); } return $retval; } sub Delta_DHMS { DATECALC_USAGE('Delta_DHMS($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2)') unless (@_ == 12); my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_; my($Dd,$Dh,$Dm,$Ds); if (DateCalc_check_date($year1,$month1,$day1) and DateCalc_check_date($year2,$month2,$day2)) { if (DateCalc_check_time($hour1,$min1,$sec1) and DateCalc_check_time($hour2,$min2,$sec2)) { if (DateCalc_delta_dhms(\$Dd,\$Dh,\$Dm,\$Ds, $year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2)) { return($Dd,$Dh,$Dm,$Ds); } else { DATECALC_DATE_ERROR('Delta_DHMS'); } } else { DATECALC_TIME_ERROR('Delta_DHMS'); } } else { DATECALC_DATE_ERROR('Delta_DHMS'); } } sub Delta_YMD { DATECALC_USAGE('Delta_YMD($year1,$month1,$day1,$year2,$month2,$day2)') unless (@_ == 6); my($year1,$month1,$day1,$year2,$month2,$day2) = @_; if (DateCalc_delta_ymd(\$year1,\$month1,\$day1, $year2,$month2,$day2)) { return($year1,$month1,$day1); } else { DATECALC_DATE_ERROR('Delta_YMD'); } } sub Delta_YMDHMS { DATECALC_USAGE('Delta_YMDHMS($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2)') unless (@_ == 12); my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_; my($D_y,$D_m,$D_d,$Dh,$Dm,$Ds); if (DateCalc_check_date($year1,$month1,$day1) and DateCalc_check_date($year2,$month2,$day2)) { if (DateCalc_check_time($hour1,$min1,$sec1) and DateCalc_check_time($hour2,$min2,$sec2)) { if (DateCalc_delta_ymdhms(\$D_y,\$D_m,\$D_d, \$Dh,\$Dm,\$Ds, $year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2)) { return($D_y,$D_m,$D_d,$Dh,$Dm,$Ds); } else { DATECALC_DATE_ERROR('Delta_YMDHMS'); } } else { DATECALC_TIME_ERROR('Delta_YMDHMS'); } } else { DATECALC_DATE_ERROR('Delta_YMDHMS'); } } sub N_Delta_YMD { DATECALC_USAGE('N_Delta_YMD($year1,$month1,$day1,$year2,$month2,$day2)') unless (@_ == 6); my($year1,$month1,$day1,$year2,$month2,$day2) = @_; if (DateCalc_norm_delta_ymd(\$year1,\$month1,\$day1, $year2,$month2,$day2)) { return($year1,$month1,$day1); } else { DATECALC_DATE_ERROR('N_Delta_YMD'); } } sub N_Delta_YMDHMS { DATECALC_USAGE('N_Delta_YMDHMS($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2)') unless (@_ == 12); my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_; my($D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss); if (DateCalc_check_date($year1,$month1,$day1) and DateCalc_check_date($year2,$month2,$day2)) { if (DateCalc_check_time($hour1,$min1,$sec1) and DateCalc_check_time($hour2,$min2,$sec2)) { if (DateCalc_norm_delta_ymdhms(\$D_y,\$D_m,\$D_d, \$Dhh,\$Dmm,\$Dss, $year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2)) { return($D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss); } else { DATECALC_DATE_ERROR('N_Delta_YMDHMS'); } } else { DATECALC_TIME_ERROR('N_Delta_YMDHMS'); } } else { DATECALC_DATE_ERROR('N_Delta_YMDHMS'); } } sub Normalize_DHMS { DATECALC_USAGE('Normalize_DHMS($Dd,$Dh,$Dm,$Ds)') unless (@_ == 4); my($Dd,$Dh,$Dm,$Ds) = @_; DateCalc_Normalize_DHMS(\$Dd,\$Dh,\$Dm,\$Ds); return($Dd,$Dh,$Dm,$Ds); } sub Add_Delta_Days { DATECALC_USAGE('Add_Delta_Days($year,$month,$day,$Dd)') unless (@_ == 4); my($year,$month,$day,$Dd) = @_; if (DateCalc_add_delta_days(\$year,\$month,\$day, $Dd)) { return($year,$month,$day); } else { DATECALC_DATE_ERROR('Add_Delta_Days'); } } sub Add_Delta_DHMS { DATECALC_USAGE('Add_Delta_DHMS($year,$month,$day,$hour,$min,$sec,$Dd,$Dh,$Dm,$Ds)') unless (@_ == 10); my($year,$month,$day,$hour,$min,$sec,$Dd,$Dh,$Dm,$Ds) = @_; if (DateCalc_check_date($year,$month,$day)) { if (DateCalc_check_time($hour,$min,$sec)) { if (DateCalc_add_delta_dhms(\$year,\$month,\$day, \$hour,\$min,\$sec, $Dd,$Dh,$Dm,$Ds)) { return($year,$month,$day,$hour,$min,$sec); } else { DATECALC_DATE_ERROR('Add_Delta_DHMS'); } } else { DATECALC_TIME_ERROR('Add_Delta_DHMS'); } } else { DATECALC_DATE_ERROR('Add_Delta_DHMS'); } } sub Add_Delta_YM { DATECALC_USAGE('Add_Delta_YM($year,$month,$day,$Dy,$Dm)') unless (@_ == 5); my($year,$month,$day,$Dy,$Dm) = @_; if (DateCalc_add_delta_ym(\$year,\$month,\$day, $Dy,$Dm)) { return($year,$month,$day); } else { DATECALC_DATE_ERROR('Add_Delta_YM'); } } sub Add_Delta_YMD { DATECALC_USAGE('Add_Delta_YMD($year,$month,$day,$Dy,$Dm,$Dd)') unless (@_ == 6); my($year,$month,$day,$Dy,$Dm,$Dd) = @_; if (DateCalc_add_delta_ymd(\$year,\$month,\$day, $Dy,$Dm,$Dd)) { return($year,$month,$day); } else { DATECALC_DATE_ERROR('Add_Delta_YMD'); } } sub Add_Delta_YMDHMS { DATECALC_USAGE('Add_Delta_YMDHMS($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds)') unless (@_ == 12); my($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds) = @_; if (DateCalc_check_date($year,$month,$day)) { if (DateCalc_check_time($hour,$min,$sec)) { if (DateCalc_add_delta_ymdhms(\$year,\$month,\$day, \$hour,\$min,\$sec, $D_y,$D_m,$D_d, $Dh,$Dm,$Ds)) { return($year,$month,$day,$hour,$min,$sec); } else { DATECALC_DATE_ERROR('Add_Delta_YMDHMS'); } } else { DATECALC_TIME_ERROR('Add_Delta_YMDHMS'); } } else { DATECALC_DATE_ERROR('Add_Delta_YMDnMS'); } } sub Add_N_Delta_YMD { DATECALC_USAGE('Add_N_Delta_YMD($year,$month,$day,$Dy,$Dm,$Dd)') unless (@_ == 6); my($year,$month,$day,$Dy,$Dm,$Dd) = @_; if (DateCalc_add_norm_delta_ymd(\$year,\$month,\$day, $Dy,$Dm,$Dd)) { return($year,$month,$day); } else { DATECALC_DATE_ERROR('Add_N_Delta_YMD'); } } sub Add_N_Delta_YMDHMS { DATECALC_USAGE('Add_N_Delta_YMDHMS($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss)') unless (@_ == 12); my($year,$month,$day,$hour,$min,$sec,$D_y,$D_m,$D_d,$Dhh,$Dmm,$Dss) = @_; if (DateCalc_check_date($year,$month,$day)) { if (DateCalc_check_time($hour,$min,$sec)) { if (DateCalc_add_norm_delta_ymdhms(\$year,\$month,\$day, \$hour,\$min,\$sec, $D_y,$D_m,$D_d, $Dhh,$Dmm,$Dss)) { return($year,$month,$day,$hour,$min,$sec); } else { DATECALC_DATE_ERROR('Add_N_Delta_YMDHMS'); } } else { DATECALC_TIME_ERROR('Add_N_Delta_YMDHMS'); } } else { DATECALC_DATE_ERROR('Add_N_Delta_YMDHMS'); } } sub System_Clock { DATECALC_USAGE('System_Clock([$gmt])') unless ((@_ == 0) or (@_ == 1)); my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt); if (@_ == 1) { $gmt = shift; } else { $gmt = 0; } if (DateCalc_system_clock(\$year,\$month,\$day, \$hour,\$min,\$sec, \$doy,\$dow,\$dst, $gmt)) { return($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst); } else { DATECALC_SYSTEM_ERROR('System_Clock'); } } sub Today { DATECALC_USAGE('Today([$gmt])') unless ((@_ == 0) or (@_ == 1)); my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt); if (@_ == 1) { $gmt = shift; } else { $gmt = 0; } if (DateCalc_system_clock(\$year,\$month,\$day, \$hour,\$min,\$sec, \$doy,\$dow,\$dst, $gmt)) { return($year,$month,$day); } else { DATECALC_SYSTEM_ERROR('Today'); } } sub Now { DATECALC_USAGE('Now([$gmt])') unless ((@_ == 0) or (@_ == 1)); my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt); if (@_ == 1) { $gmt = shift; } else { $gmt = 0; } if (DateCalc_system_clock(\$year,\$month,\$day, \$hour,\$min,\$sec, \$doy,\$dow,\$dst, $gmt)) { return($hour,$min,$sec); } else { DATECALC_SYSTEM_ERROR('Now'); } } sub Today_and_Now { DATECALC_USAGE('Today_and_Now([$gmt])') unless ((@_ == 0) or (@_ == 1)); my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt); if (@_ == 1) { $gmt = shift; } else { $gmt = 0; } if (DateCalc_system_clock(\$year,\$month,\$day, \$hour,\$min,\$sec, \$doy,\$dow,\$dst, $gmt)) { return($year,$month,$day,$hour,$min,$sec); } else { DATECALC_SYSTEM_ERROR('Today_and_Now'); } } sub This_Year { DATECALC_USAGE('This_Year([$gmt])') unless ((@_ == 0) or (@_ == 1)); my($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst,$gmt); if (@_ == 1) { $gmt = shift; } else { $gmt = 0; } if (DateCalc_system_clock(\$year,\$month,\$day, \$hour,\$min,\$sec, \$doy,\$dow,\$dst, $gmt)) { return($year); } else { DATECALC_SYSTEM_ERROR('This_Year'); } } sub Gmtime { DATECALC_USAGE('Gmtime([time])') unless ((@_ == 0) or (@_ == 1)); my($seconds,$year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst); if (@_ == 1) { $seconds = shift; } else { $seconds = time; } if (($seconds < 0) or ($seconds > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Gmtime'); } if (DateCalc_gmtime(\$year,\$month,\$day, \$hour,\$min,\$sec, \$doy,\$dow,\$dst, $seconds)) { return($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst); } else { DATECALC_TIME_RANGE_ERROR('Gmtime'); } } sub Localtime { DATECALC_USAGE('Localtime([time])') unless ((@_ == 0) or (@_ == 1)); my($seconds,$year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst); if (@_ == 1) { $seconds = shift; } else { $seconds = time; } if (($seconds < 0) or ($seconds > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Localtime'); } if (DateCalc_localtime(\$year,\$month,\$day, \$hour,\$min,\$sec, \$doy,\$dow,\$dst, $seconds)) { return($year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst); } else { DATECALC_TIME_RANGE_ERROR('Localtime'); } } sub Mktime { DATECALC_USAGE('Mktime($year,$month,$day,$hour,$min,$sec)') unless (@_ == 6); my($year,$month,$day,$hour,$min,$sec) = @_; my($seconds); if (DateCalc_mktime(\$seconds, $year,$month,$day, $hour,$min,$sec, -1,-1,-1)) { return $seconds; } else { DATECALC_DATE_RANGE_ERROR('Mktime'); } } sub Timezone { DATECALC_USAGE('Timezone([time])') unless ((@_ == 0) or (@_ == 1)); my($when,$year,$month,$day,$hour,$min,$sec,$dst); if (@_ == 1) { $when = shift; } else { $when = time; } if (($when < 0) or ($when > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Timezone'); } if (DateCalc_timezone(\$year,\$month,\$day, \$hour,\$min,\$sec, \$dst,$when)) { return($year,$month,$day,$hour,$min,$sec,$dst); } else { DATECALC_TIME_RANGE_ERROR('Timezone'); } } sub Date_to_Time { DATECALC_USAGE('Date_to_Time($year,$month,$day,$hour,$min,$sec)') unless (@_ == 6); my($year,$month,$day,$hour,$min,$sec) = @_; my($seconds); if (DateCalc_date2time(\$seconds, $year,$month,$day, $hour,$min,$sec)) { return $seconds; } else { DATECALC_DATE_RANGE_ERROR('Date_to_Time'); } } sub Time_to_Date { DATECALC_USAGE('Time_to_Date([time])') unless ((@_ == 0) or (@_ == 1)); my($seconds,$year,$month,$day,$hour,$min,$sec); if (@_ == 1) { $seconds = shift; } else { $seconds = time; } if (($seconds < 0) or ($seconds > 0xFFFFFFFF)) { DATECALC_TIME_RANGE_ERROR('Time_to_Date'); } if (DateCalc_time2date(\$year,\$month,\$day, \$hour,\$min,\$sec, $seconds)) { return($year,$month,$day,$hour,$min,$sec); } else { DATECALC_TIME_RANGE_ERROR('Time_to_Date'); } } sub Easter_Sunday { DATECALC_USAGE('Easter_Sunday($year)') unless (@_ == 1); my($year) = shift; my($month,$day); if (($year > 0) and DateCalc_easter_sunday(\$year,\$month,\$day)) { return($year,$month,$day); } else { DATECALC_YEAR_ERROR('Easter_Sunday'); } } sub Decode_Month { DATECALC_USAGE('Decode_Month($string[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($string) = shift; my($lang) = shift || 0; return DateCalc_Decode_Month($string,$lang); } sub Decode_Day_of_Week { DATECALC_USAGE('Decode_Day_of_Week($string[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($string) = shift; my($lang) = shift || 0; return DateCalc_Decode_Day_of_Week($string,$lang); } sub Decode_Language { DATECALC_USAGE('Decode_Language($string)') unless (@_ == 1); my($string) = shift; return DateCalc_Decode_Language($string); } sub Decode_Date_EU { DATECALC_USAGE('Decode_Date_EU($string[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($string) = shift; my($lang) = shift || 0; my($year,$month,$day); if (DateCalc_decode_date_eu($string,\$year,\$month,\$day,$lang)) { return($year,$month,$day); } else { return(); } } sub Decode_Date_US { DATECALC_USAGE('Decode_Date_US($string[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($string) = shift; my($lang) = shift || 0; my($year,$month,$day); if (DateCalc_decode_date_us($string,\$year,\$month,\$day,$lang)) { return($year,$month,$day); } else { return(); } } sub Fixed_Window { DATECALC_USAGE('Fixed_Window($year)') unless (@_ == 1); my($year) = shift; return DateCalc_Fixed_Window($year); } sub Moving_Window { DATECALC_USAGE('Moving_Window($year)') unless (@_ == 1); my($year) = shift; return DateCalc_Moving_Window($year); } sub Compress { DATECALC_USAGE('Compress($year,$month,$day)') unless (@_ == 3); my($year,$month,$day) = @_; return DateCalc_Compress($year,$month,$day); } sub Uncompress { DATECALC_USAGE('Uncompress($date)') unless (@_ == 1); my($date) = shift; my($century,$year,$month,$day); if (DateCalc_uncompress($date,\$century,\$year,\$month,\$day)) { return($century,$year,$month,$day); } else { return(); } } sub check_compressed { DATECALC_USAGE('check_compressed($date)') unless (@_ == 1); my($date) = shift; return DateCalc_check_compressed($date); } sub Compressed_to_Text { DATECALC_USAGE('Compressed_to_Text($date[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($date) = shift; my($lang) = shift || 0; return DateCalc_Compressed_to_Text($date,$lang); } sub Date_to_Text { DATECALC_USAGE('Date_to_Text($year,$month,$day[,$lang])') unless ((@_ == 3) or (@_ == 4)); my($year) = shift; my($month) = shift; my($day) = shift; my($lang) = shift || 0; if (DateCalc_check_date($year,$month,$day)) { return DateCalc_Date_to_Text($year,$month,$day,$lang); } else { DATECALC_DATE_ERROR('Date_to_Text'); } } sub Date_to_Text_Long { DATECALC_USAGE('Date_to_Text_Long($year,$month,$day[,$lang])') unless ((@_ == 3) or (@_ == 4)); my($year) = shift; my($month) = shift; my($day) = shift; my($lang) = shift || 0; if (DateCalc_check_date($year,$month,$day)) { return DateCalc_Date_to_Text_Long($year,$month,$day,$lang); } else { DATECALC_DATE_ERROR('Date_to_Text_Long'); } } sub English_Ordinal { DATECALC_USAGE('English_Ordinal($number)') unless (@_ == 1); my($number) = shift; return DateCalc_English_Ordinal($number); } sub Calendar { DATECALC_USAGE('Calendar($year,$month[,$orthodox[,$lang]])') if ((@_ < 2) or (@_ > 4)); my($year) = shift; my($month) = shift; my($orthodox,$lang); if (@_ == 2) { $orthodox = shift; $lang = shift; } elsif (@_ == 1) { $orthodox = shift; $lang = 0; } else { $orthodox = 0; $lang = 0; } if ($year > 0) { if (($month >= 1) and ($month <= 12)) { return DateCalc_Calendar($year,$month,$orthodox,$lang); } else { DATECALC_MONTH_ERROR('Calendar'); } } else { DATECALC_YEAR_ERROR('Calendar'); } } sub Month_to_Text { DATECALC_USAGE('Month_to_Text($month[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($month) = shift; my($lang) = shift || 0; if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; } if (($month >= 1) and ($month <= 12)) { return $DateCalc_Month_to_Text_[$lang][$month]; } else { DATECALC_MONTH_ERROR('Month_to_Text'); } } sub Day_of_Week_to_Text { DATECALC_USAGE('Day_of_Week_to_Text($dow[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($dow) = shift; my($lang) = shift || 0; if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; } if (($dow >= 1) and ($dow <= 7)) { return $DateCalc_Day_of_Week_to_Text_[$lang][$dow]; } else { DATECALC_DAYOFWEEK_ERROR('Day_of_Week_to_Text'); } } sub Day_of_Week_Abbreviation { DATECALC_USAGE('Day_of_Week_Abbreviation($dow[,$lang])') unless ((@_ == 1) or (@_ == 2)); my($dow) = shift; my($lang) = shift || 0; if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; } if (($dow >= 1) and ($dow <= 7)) { if ($DateCalc_Day_of_Week_Abbreviation_[$lang][0] ne '') { return $DateCalc_Day_of_Week_Abbreviation_[$lang][$dow]; } else { return substr($DateCalc_Day_of_Week_to_Text_[$lang][$dow],0,3); } } else { DATECALC_DAYOFWEEK_ERROR('Day_of_Week_Abbreviation'); } } sub Language_to_Text { DATECALC_USAGE('Language_to_Text($lang)') unless (@_ == 1); my($lang) = shift; if (($lang >= 1) and ($lang <= $DateCalc_LANGUAGES)) { return $DateCalc_Language_to_Text_[$lang]; } else { DATECALC_LANGUAGE_ERROR('Language_to_Text'); } } sub Language { DATECALC_USAGE('Language([$lang])') unless ((@_ == 0) or (@_ == 1)); my($retval) = $DateCalc_Language; my($lang); if (@_ == 1) { $lang = shift || 0; if (($lang >= 1) and ($lang <= $DateCalc_LANGUAGES)) { $DateCalc_Language = $lang; } else { DATECALC_LANGUAGE_ERROR('Language'); } } return $retval; } sub Languages { DATECALC_USAGE('Languages()') unless (@_ == 0); return $DateCalc_LANGUAGES; } sub ISO_LC { DATECALC_USAGE('ISO_LC($string)') unless (@_ == 1); my($string) = shift; $string =~ s!([\x41-\x5A\xC0-\xD6\xD8-\xDE])!chr(ord($1)+0x20)!ge; return $string; } sub ISO_UC { DATECALC_USAGE('ISO_UC($string)') unless (@_ == 1); my($string) = shift; $string =~ s!([\x61-\x7A\xE0-\xF6\xF8-\xFE])!chr(ord($1)-0x20)!ge; return $string; } ################## ## ## ## DateCalc.c ## ## ## ################## ######################## ## Private functions: ## ######################## sub DateCalc_is_digit { return 1 if ($_[0] =~ /^[0-9]+$/); return 0; } sub DateCalc_is_alnum { return 1 if ($_[0] =~ /^[\x30-\x39\x41-\x5A\x61-\x7A\xC0-\xD6\xD8-\xF6\xF8-\xFF]+$/); return 0; } sub DateCalc_ISO_LC { my($char) = $_[0]; $char =~ s!([\x41-\x5A\xC0-\xD6\xD8-\xDE])!chr(ord($1)+0x20)!ge; return $char; } sub DateCalc_ISO_UC { my($char) = $_[0]; $char =~ s!([\x61-\x7A\xE0-\xF6\xF8-\xFE])!chr(ord($1)-0x20)!ge; return $char; } sub DateCalc_ISO_UC_First { my($string) = $_[0]; $string =~ s!([\x41-\x5A\xC0-\xD6\xD8-\xDE])!chr(ord($1)+0x20)!ge; $string =~ s!^([\x61-\x7A\xE0-\xF6\xF8-\xFE])!chr(ord($1)-0x20)!e; return $string; } sub DateCalc_Year_to_Days { my($year) = $_[0]; my($days) = $year * 365; $year >>= 2; $days += $year; $year = int($year / 25); $days -= $year; $days += ($year >> 2); return $days; } sub DateCalc_scan9 { ## Mnemonic: COBOL "PIC 9" ## my($str,$buf,$len,$idx,$neg) = @_; $idx += $buf; $len += $buf; if (($idx >= 0) and ($idx < $len)) { return DateCalc_is_digit(substr($str,$idx,1)) ^ $neg; } return 0; } sub DateCalc_scanx { ## Mnemonic: COBOL "PIC X" ## my($str,$buf,$len,$idx,$neg) = @_; $idx += $buf; $len += $buf; if (($idx >= 0) and ($idx < $len)) { return DateCalc_is_alnum(substr($str,$idx,1)) ^ $neg; } return 0; } sub DateCalc_Center { my($_target,$source,$width) = @_; my($length,$blank); $length = length($source); $length = $width if ($length > $width); $blank = $width - $length; $blank >>= 1; $$_target .= ' ' x $blank; $$_target .= substr($source,0,$length); $$_target .= "\n"; } sub DateCalc_Blank { my($_target,$count) = @_; $$_target .= ' ' x $count; } sub DateCalc_Newline { my($_target,$count) = @_; $$_target .= "\n" x $count; } sub DateCalc_Normalize_Time { my($_Dd,$_Dh,$_Dm,$_Ds) = @_; my($quot); $quot = int($$_Ds / 60); $$_Ds -= $quot * 60; $$_Dm += $quot; $quot = int($$_Dm / 60); $$_Dm -= $quot * 60; $$_Dh += $quot; $quot = int($$_Dh / 24); $$_Dh -= $quot * 24; $$_Dd += $quot; } ## Prevent overflow errors on systems ## ## with short "long"s (e.g. 32 bits): ## sub DateCalc_Normalize_Ranges { my($_Dd,$_Dh,$_Dm,$_Ds) = @_; my($quot); $quot = int($$_Dh / 24); $$_Dh -= $quot * 24; $$_Dd += $quot; $quot = int($$_Dm / 60); $$_Dm -= $quot * 60; $$_Dh += $quot; DateCalc_Normalize_Time($_Dd,$_Dh,$_Dm,$_Ds); } # $_Dh and $_Dm are assumed to be empty; # the whole time part must be in $_Ds: sub DateCalc_Normalize_Signs { my($_Dd,$_Dh,$_Dm,$_Ds) = @_; my($quot); $quot = int($$_Ds / 86400); $$_Ds -= $quot * 86400; $$_Dd += $quot; if ($$_Dd != 0) { if ($$_Dd > 0) { if ($$_Ds < 0) { $$_Ds += 86400; ${$_Dd}--; } } else { if ($$_Ds > 0) { $$_Ds -= 86400; ${$_Dd}++; } } } $$_Dh = 0; $$_Dm = 0; if ($$_Ds != 0) { DateCalc_Normalize_Time($_Dd,$_Dh,$_Dm,$_Ds); } } sub DateCalc_Normalize_DHMS { my($_Dd,$_Dh,$_Dm,$_Ds) = @_; DateCalc_Normalize_Ranges($_Dd,$_Dh,$_Dm,$_Ds); $$_Ds += (($$_Dh * 60) + $$_Dm) * 60; DateCalc_Normalize_Signs($_Dd,$_Dh,$_Dm,$_Ds); } ####################### ## Public functions: ## ####################### sub DateCalc_leap_year { my($year) = $_[0]; my($yy); return( (($year & 0x03) == 0) and ( ((($yy = int($year / 100)) * 100) != $year) or (($yy & 0x03) == 0) ) ); } sub DateCalc_check_date { my($year,$month,$day) = @_; return 1 if (($year >= 1) and ($month >= 1) and ($month <= 12) and ($day >= 1) and ($day <= $DateCalc_Days_in_Month_[DateCalc_leap_year($year)][$month])); return 0; } sub DateCalc_check_time { my($hour,$min,$sec) = @_; return 1 if (($hour >= 0) and ($min >= 0) and ($sec >= 0) and ($hour < 24) and ($min < 60) and ($sec < 60)); return 0; } sub DateCalc_check_business_date { my($year,$week,$dow) = @_; return 1 if (($year >= 1) and ($week >= 1) and ($week <= DateCalc_Weeks_in_Year($year)) and ($dow >= 1) and ($dow <= 7)); return 0; } sub DateCalc_Day_of_Year { my($year,$month,$day) = @_; my($leap); if (($year >= 1) and ($month >= 1) and ($month <= 12) and ($day >= 1) and ($day <= $DateCalc_Days_in_Month_[($leap=DateCalc_leap_year($year))][$month])) { return $DateCalc_Days_in_Year_[$leap][$month] + $day; } return 0; } sub DateCalc_Date_to_Days { my($year,$month,$day) = @_; my($leap); if (($year >= 1) and ($month >= 1) and ($month <= 12) and ($day >= 1) and ($day <= $DateCalc_Days_in_Month_[($leap=DateCalc_leap_year($year))][$month])) { return DateCalc_Year_to_Days(--$year) + $DateCalc_Days_in_Year_[$leap][$month] + $day; } return 0; } sub DateCalc_Day_of_Week { my($year,$month,$day) = @_; my($days); $days = DateCalc_Date_to_Days($year,$month,$day); if ($days > 0) { $days--; $days %= 7; $days++; } return $days; } sub DateCalc_Weeks_in_Year { my($year) = $_[0]; if ((DateCalc_Day_of_Week($year,1,1) == 4) or (DateCalc_Day_of_Week($year,12,31) == 4)) { return 53; } else { return 52; } } sub DateCalc_Week_Number { my($year,$month,$day) = @_; my($first,$week); $first = DateCalc_Day_of_Week($year,1,1) - 1; $week = int((DateCalc_Delta_Days($year,1,1, $year,$month,$day) + $first) / 7); if ($first < 4) { return ++$week; } else { return $week; } } sub DateCalc_week_of_year { my($_week,$_year,$month,$day) = @_; if (DateCalc_check_date($$_year,$month,$day)) { $$_week = DateCalc_Week_Number($$_year,$month,$day); if ($$_week == 0) { $$_week = DateCalc_Weeks_in_Year(--${$_year}); } elsif ($$_week > DateCalc_Weeks_in_Year($$_year)) { $$_week = 1; ${$_year}++; } return 1; } return 0; } sub DateCalc_monday_of_week { my($week,$_year,$_month,$_day) = @_; my($first); $$_month = $$_day = 1; $first = DateCalc_Day_of_Week($$_year,1,1) - 1; $week-- if ($first < 4); return DateCalc_add_delta_days($_year,$_month,$_day, ($week * 7 - $first)); } sub DateCalc_nth_weekday_of_month_year { my($_year,$_month,$_day,$dow,$n) = @_; my($mm) = $$_month; my($first,$delta); $$_day = 1; return 0 if (($$_year < 1) or ($mm < 1) or ($mm > 12) or ($dow < 1) or ($dow > 7) or ($n < 1) or ($n > 5)); $first = DateCalc_Day_of_Week($$_year,$mm,1); $dow += 7 if ($dow < $first); $delta = $dow - $first; $delta += --$n * 7; return 1 if (DateCalc_add_delta_days($_year,$_month,$_day,$delta) and ($$_month == $mm)); return 0; } sub DateCalc_standard_to_business { my($_year,$_week,$_dow,$month,$day) = @_; my($yy) = $$_year; if (DateCalc_week_of_year($_week,$_year,$month,$day)) { $$_dow = DateCalc_Day_of_Week($yy,$month,$day); return 1; } return 0; } sub DateCalc_business_to_standard { my($_year,$_month,$_day,$week,$dow) = @_; my($first,$delta); if (DateCalc_check_business_date($$_year,$week,$dow)) { $$_month = $$_day = 1; $first = DateCalc_Day_of_Week($$_year,1,1); $week++ if ($first > 4); $delta = --$week * 7 + $dow - $first; return DateCalc_add_delta_days($_year,$_month,$_day,$delta); } return 0; } sub DateCalc_Delta_Days { return DateCalc_Date_to_Days(@_[3..5]) - DateCalc_Date_to_Days(@_[0..2]); } sub DateCalc_delta_hms { my($_Dd,$_Dh,$_Dm,$_Ds,$hour1,$min1,$sec1,$hour2,$min2,$sec2) = @_; if (DateCalc_check_time($hour1,$min1,$sec1) and DateCalc_check_time($hour2,$min2,$sec2)) { $$_Ds = (((($hour2 * 60) + $min2) * 60) + $sec2) - (((($hour1 * 60) + $min1) * 60) + $sec1); DateCalc_Normalize_Signs($_Dd,$_Dh,$_Dm,$_Ds); return 1; } return 0; } sub DateCalc_delta_dhms { my($_Dd,$_Dh,$_Dm,$_Ds,$year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_; $$_Dd = $$_Dh = $$_Dm = $$_Ds = 0; if (DateCalc_check_date($year1,$month1,$day1) and DateCalc_check_date($year2,$month2,$day2)) { $$_Dd = DateCalc_Delta_Days($year1,$month1,$day1, $year2,$month2,$day2); return DateCalc_delta_hms($_Dd,$_Dh,$_Dm,$_Ds, $hour1,$min1,$sec1, $hour2,$min2,$sec2); } return 0; } sub DateCalc_delta_ymd { my($_year1,$_month1,$_day1,$year2,$month2,$day2) = @_; if (DateCalc_check_date($$_year1,$$_month1,$$_day1) and DateCalc_check_date( $year2, $month2, $day2)) { $$_day1 = $day2 - $$_day1; $$_month1 = $month2 - $$_month1; $$_year1 = $year2 - $$_year1; return 1; } return 0; } sub DateCalc_delta_ymdhms { my($_D_y,$_D_m,$_D_d,$_Dh,$_Dm,$_Ds,$year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_; return 0 unless (DateCalc_delta_ymd(\$year1,\$month1,\$day1, $year2,$month2,$day2)); $$_D_d = $day1; return 0 unless (DateCalc_delta_hms($_D_d,$_Dh,$_Dm,$_Ds, $hour1,$min1,$sec1, $hour2,$min2,$sec2)); $$_D_y = $year1; $$_D_m = $month1; return 1; } sub DateCalc_norm_delta_ymd { my($_year1,$_month1,$_day1,$year2,$month2,$day2) = @_; my($Dy) = 0; my($Dm) = 0; my($Dd) = 0; my($d2,$ty,$tm,$td); if (DateCalc_check_date($$_year1,$$_month1,$$_day1) and DateCalc_check_date( $year2, $month2, $day2)) { $d2 = DateCalc_Date_to_Days( $year2, $month2, $day2); $Dd = $d2-DateCalc_Date_to_Days($$_year1,$$_month1,$$_day1); if (($Dd < -30) or ($Dd > 30)) { $Dy = ($year2 - $$_year1); $Dm = ($month2 - $$_month1); $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); unless ((($Dy >= 0) and ($Dm >= 0) and ($Dd >= 0)) or (($Dy <= 0) and ($Dm <= 0) and ($Dd <= 0))) { if (($Dy < 0) and ($Dm > 0)) { $Dy++; $Dm -= 12; } elsif (($Dy > 0) and ($Dm < 0)) { $Dy--; $Dm += 12; } if (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } if (($Dy < 0) and ($Dd > 0)) { $Dy++; $Dm -= 12; } elsif (($Dy > 0) and ($Dd < 0)) { $Dy--; $Dm += 12; } if (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$$_year1; $tm=$$_month1; $td=$$_day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } } } $$_year1 = $Dy; $$_month1 = $Dm; $$_day1 = $Dd; return 1; } return 0; } sub DateCalc_norm_delta_ymdhms { my($_D_y,$_D_m,$_D_d,$_Dhh,$_Dmm,$_Dss,$year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2) = @_; my($Dy) = 0; my($Dm) = 0; my($Dd) = 0; my($d2,$ty,$tm,$td,$hh,$mm,$ss); if (DateCalc_check_date($year1,$month1,$day1) and DateCalc_check_time($hour1,$min1, $sec1) and DateCalc_check_date($year2,$month2,$day2) and DateCalc_check_time($hour1,$min2, $sec2)) { $ss = ( ($hour2-$hour1) * 60 + ($min2-$min1) ) * 60 + ($sec2-$sec1); $d2 = DateCalc_Date_to_Days($year2,$month2,$day2); $Dd = $d2-DateCalc_Date_to_Days($year1,$month1,$day1); if (($Dd < -30) or ($Dd > 30)) { $Dy = $year2 - $year1; $Dm = $month2 - $month1; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); unless ((($Dy >= 0) and ($Dm >= 0) and ($Dd >= 0) and ($ss >= 0)) or (($Dy <= 0) and ($Dm <= 0) and ($Dd <= 0) and ($ss <= 0))) { if (($Dy < 0) and ($Dm > 0)) { $Dy++; $Dm -= 12; } elsif (($Dy > 0) and ($Dm < 0)) { $Dy--; $Dm += 12; } if (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } if (($Dy < 0) and ($Dd > 0)) { $Dy++; $Dm -= 12; } elsif (($Dy > 0) and ($Dd < 0)) { $Dy--; $Dm += 12; } if (($Dm < 0) and ($Dd > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } elsif (($Dm > 0) and ($Dd < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } if (($Dd < 0) and ($ss > 0)) { $Dd++; $ss -= 86400; } elsif (($Dd > 0) and ($ss < 0)) { $Dd--; $ss += 86400; } if (($Dm < 0) and ($ss > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } elsif (($Dm > 0) and ($ss < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } if (($Dy < 0) and ($ss > 0)) { $Dy++; $Dm -= 12; } elsif (($Dy > 0) and ($ss < 0)) { $Dy--; $Dm += 12; } if (($Dm < 0) and ($ss > 0)) { $Dm++; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } elsif (($Dm > 0) and ($ss < 0)) { $Dm--; $ty=$year1; $tm=$month1; $td=$day1; return 0 unless (DateCalc_add_delta_ym(\$ty,\$tm,\$td,$Dy,$Dm)); $Dd=$d2-DateCalc_Date_to_Days($ty,$tm,$td); } if (($Dd < 0) and ($ss > 0)) { $Dd++; $ss -= 86400; } elsif (($Dd > 0) and ($ss < 0)) { $Dd--; $ss += 86400; } } } else { if (($Dd < 0) and ($ss > 0)) { $Dd++; $ss -= 86400; } elsif (($Dd > 0) and ($ss < 0)) { $Dd--; $ss += 86400; } } $mm = int( $ss / 60 ); $ss -= $mm * 60; $hh = int( $mm / 60 ); $mm -= $hh * 60; $$_D_y = $Dy; $$_D_m = $Dm; $$_D_d = $Dd; $$_Dhh = $hh; $$_Dmm = $mm; $$_Dss = $ss; return 1; } return 0; } sub DateCalc_add_delta_days { my($_year,$_month,$_day,$Dd) = @_; my($days,$leap); if ((($days = DateCalc_Date_to_Days($$_year,$$_month,$$_day)) > 0) and (($days += $Dd) > 0)) { if ($Dd != 0) { $$_year = int( $days / 365.2425 ); $$_day = $days - DateCalc_Year_to_Days($$_year); if ($$_day < 1) { $$_day = $days - DateCalc_Year_to_Days($$_year-1); } else { ${$_year}++; } $leap = DateCalc_leap_year($$_year); if ($$_day > $DateCalc_Days_in_Year_[$leap][13]) { $$_day -= $DateCalc_Days_in_Year_[$leap][13]; $leap = DateCalc_leap_year(++${$_year}); } for ( $$_month = 12; $$_month >= 1; ${$_month}-- ) { if ($$_day > $DateCalc_Days_in_Year_[$leap][$$_month]) { $$_day -= $DateCalc_Days_in_Year_[$leap][$$_month]; last; } } } return 1; } return 0; } sub DateCalc_add_delta_dhms { my($_year,$_month,$_day,$_hour,$_min,$_sec,$Dd,$Dh,$Dm,$Ds) = @_; if (DateCalc_check_date($$_year,$$_month,$$_day) and DateCalc_check_time($$_hour,$$_min, $$_sec)) { DateCalc_Normalize_Ranges(\$Dd,\$Dh,\$Dm,\$Ds); $Ds += (((($$_hour * 60) + $$_min) * 60) + $$_sec) + ((( $Dh * 60) + $Dm) * 60); while ($Ds < 0) { $Ds += 86400; $Dd--; } if ($Ds > 0) { $Dh = 0; $Dm = 0; DateCalc_Normalize_Time(\$Dd,\$Dh,\$Dm,\$Ds); $$_hour = $Dh; $$_min = $Dm; $$_sec = $Ds; } else { $$_hour = $$_min = $$_sec = 0; } return DateCalc_add_delta_days($_year,$_month,$_day,$Dd); } return 0; } sub DateCalc_add_year_month { my($_year,$_month,$Dy,$Dm) = @_; my($quot); return 0 if (($$_year < 1) or ($$_month < 1) or ($$_month > 12)); if ($Dm != 0) { $Dm += $$_month - 1; $quot = int($Dm / 12); $Dm -= $quot * 12; if ($Dm < 0) { $Dm += 12; $quot--; } $$_month = $Dm + 1; $Dy += $quot; } if ($Dy != 0) { $$_year += $Dy; } return 0 if ($$_year < 1); return 1; } sub DateCalc_add_delta_ym { my($_year,$_month,$_day,$Dy,$Dm) = @_; my($Dd); return 0 unless (DateCalc_check_date($$_year,$$_month,$$_day)); return 0 unless (DateCalc_add_year_month($_year,$_month,$Dy,$Dm)); if ($$_day > ($Dd = $DateCalc_Days_in_Month_[DateCalc_leap_year($$_year)][$$_month])) { $$_day = $Dd; } return 1; } sub DateCalc_add_delta_ymd { my($_year,$_month,$_day,$Dy,$Dm,$Dd) = @_; return 0 unless (DateCalc_check_date($$_year,$$_month,$$_day)); return 0 unless (DateCalc_add_year_month($_year,$_month,$Dy,$Dm)); $Dd += $$_day - 1; $$_day = 1; return DateCalc_add_delta_days($_year,$_month,$_day,$Dd); } sub DateCalc_add_delta_ymdhms { my($_year,$_month,$_day,$_hour,$_min,$_sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds) = @_; return 0 unless (DateCalc_check_date($$_year,$$_month,$$_day) and DateCalc_check_time($$_hour,$$_min,$$_sec)); return 0 unless (DateCalc_add_year_month($_year,$_month,$D_y,$D_m)); $D_d += $$_day - 1; $$_day = 1; return DateCalc_add_delta_dhms($_year,$_month,$_day,$_hour,$_min,$_sec,$D_d,$Dh,$Dm,$Ds); } sub DateCalc_add_norm_delta_ymd { my($_year,$_month,$_day,$Dy,$Dm,$Dd) = @_; return 0 unless (DateCalc_add_delta_ym($_year,$_month,$_day,$Dy,$Dm)); return DateCalc_add_delta_days($_year,$_month,$_day,$Dd); } sub DateCalc_add_norm_delta_ymdhms { my($_year,$_month,$_day,$_hour,$_min,$_sec,$D_y,$D_m,$D_d,$Dh,$Dm,$Ds) = @_; return 0 unless (DateCalc_add_delta_ym($_year,$_month,$_day,$D_y,$D_m)); return DateCalc_add_delta_dhms($_year,$_month,$_day,$_hour,$_min,$_sec,$D_d,$Dh,$Dm,$Ds); } sub DateCalc_system_clock { my($_year,$_month,$_day,$_hour,$_min,$_sec,$_doy,$_dow,$_dst,$gmt) = @_; my($seconds) = time(); if ($seconds >= 0) { $$_dst = 0; if ($gmt) { ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy) = gmtime($seconds); } else { ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy,$$_dst) = localtime($seconds); } ${$_year} += 1900; ${$_month}++; ${$_dow} = 7 if (${$_dow} == 0); ${$_doy}++; if ($$_dst != 0) { if ($$_dst < 0) { $$_dst = -1; } else { $$_dst = 1; } } return 1; } return 0; } sub DateCalc_gmtime { my($_year,$_month,$_day,$_hour,$_min,$_sec,$_doy,$_dow,$_dst,$seconds) = @_; if ($seconds >= 0) { $$_dst = 0; ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy) = gmtime($seconds); ${$_year} += 1900; ${$_month}++; ${$_dow} = 7 if (${$_dow} == 0); ${$_doy}++; return 1; } return 0; } sub DateCalc_localtime { my($_year,$_month,$_day,$_hour,$_min,$_sec,$_doy,$_dow,$_dst,$seconds) = @_; if ($seconds >= 0) { ($$_sec,$$_min,$$_hour,$$_day,$$_month,$$_year,$$_dow,$$_doy,$$_dst) = localtime($seconds); ${$_year} += 1900; ${$_month}++; ${$_dow} = 7 if (${$_dow} == 0); ${$_doy}++; if ($$_dst != 0) { if ($$_dst < 0) { $$_dst = -1; } else { $$_dst = 1; } } return 1; } return 0; } ## MacOS (Classic): ## ## <695056.0> = Fri 1-Jan-1904 00:00:00 (time=0x00000000) ## ## <744766.23295> = Mon 6-Feb-2040 06:28:15 (time=0xFFFFFFFF) ## ## Unix: ## ## <719163.0> = Thu 1-Jan-1970 00:00:00 (time=0x00000000) ## ## <744018.11647> = Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) ## sub DateCalc_mktime { my($_seconds,$year,$month,$day,$hour,$min,$sec,$doy,$dow,$dst) = @_; $$_seconds = 0; if ($^O eq 'MacOS') { return 0 if ( ($year < 1904) or ($year > 2040) or ($month < 1) or ($month > 12) or ($day < 1) or ($day > 31) or ($hour < 0) or ($hour > 23) or ($min < 0) or ($min > 59) or ($sec < 0) or ($sec > 59) ); return 0 if ( ($year == 2040) and ( ($month > 2) or ( ($month == 2) and ( ($day > 6) or ( ($day == 6) and ( ($hour > 6) or ( ($hour == 6) and ( ($min > 28) or ( ($min == 28) and ($sec > 15) ) ))))))) ); } else { return 0 if ( ($year < 1970) or ($year > 2038) or ($month < 1) or ($month > 12) or ($day < 1) or ($day > 31) or ($hour < 0) or ($hour > 23) or ($min < 0) or ($min > 59) or ($sec < 0) or ($sec > 59) ); return 0 if ( ($year == 2038) and ( ($month > 1) or ( ($month == 1) and ( ($day > 19) or ( ($day == 19) and ( ($hour > 3) or ( ($hour == 3) and ( ($min > 14) or ( ($min == 14) and ($sec > 7) ) ))))))) ); } $year -= 1900; $month--; if ($doy <= 0) { $doy = -1; } else { $doy--; } if ($dow <= 0) { $dow = -1; } elsif ($dow == 7) { $dow = 0; } if ($dst != 0) { if ($dst < 0) { $dst = -1; } else { $dst = 1; } } $$_seconds = POSIX::mktime($sec,$min,$hour,$day,$month,$year,$doy,$dow,$dst) || 0; return 1 if ($$_seconds >= 0); return 0; } sub DateCalc_timezone { my($_year,$_month,$_day,$_hour,$_min,$_sec,$_dst,$when) = @_; my($year1,$month1,$day1,$hour1,$min1,$sec1,$year2,$month2,$day2,$hour2,$min2,$sec2); if ($when >= 0) { ($year1,$month1,$day1,$hour1,$min1,$sec1) = (gmtime($when))[5,4,3,2,1,0]; $year1 += 1900; $month1++; ($year2,$month2,$day2,$hour2,$min2,$sec2,$$_dst) = (localtime($when))[5,4,3,2,1,0,8]; $year2 += 1900; $month2++; if (DateCalc_delta_ymdhms($_year,$_month,$_day, $_hour,$_min,$_sec, $year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2)) { if ($$_dst != 0) { if ($$_dst < 0) { $$_dst = -1; } else { $$_dst = 1; } } return 1; } } return 0; } ## MacOS (Classic): ## ## <695056.0> = Fri 1-Jan-1904 00:00:00 (time=0x00000000) ## ## <744766.23295> = Mon 6-Feb-2040 06:28:15 (time=0xFFFFFFFF) ## ## Unix: ## ## <719163.0> = Thu 1-Jan-1970 00:00:00 (time=0x00000000) ## ## <744018.11647> = Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) ## #ifdef MACOS_TRADITIONAL #define DateCalc_DAYS_TO_EPOCH 695056 #define DateCalc_DAYS_TO_OVFLW 744766 #define DateCalc_SECS_TO_OVFLW 23295 #else #define DateCalc_DAYS_TO_EPOCH 719163 #define DateCalc_DAYS_TO_OVFLW 744018 #define DateCalc_SECS_TO_OVFLW 11647 #endif ## Substitute for BSD's timegm(3) function: ## sub DateCalc_date2time { my($_seconds,$year,$month,$day,$hour,$min,$sec) = @_; my($days,$secs); $$_seconds = 0; $days = DateCalc_Date_to_Days($year,$month,$day); $secs = ((($hour * 60) + $min) * 60) + $sec; return 0 if ( ($days < $DateCalc_DAYS_TO_EPOCH) or ($secs < 0) or ($days > $DateCalc_DAYS_TO_OVFLW) or ( ($days == $DateCalc_DAYS_TO_OVFLW) and ($secs > $DateCalc_SECS_TO_OVFLW) ) ); $$_seconds = (($days - $DateCalc_DAYS_TO_EPOCH) * 86400) + $secs; return 1; } ## Substitute for POSIX's gmtime(3) function: ## sub DateCalc_time2date { my($_year,$_month,$_day,$_hour,$_min,$_sec,$ss) = @_; my($mm,$hh,$dd); return 0 if ($ss < 0); $dd = int($ss / 86400); $ss -= $dd * 86400; $mm = int($ss / 60); $ss -= $mm * 60; $hh = int($mm / 60); $mm -= $hh * 60; $dd += $DateCalc_DAYS_TO_EPOCH-1; $$_sec = $ss; $$_min = $mm; $$_hour = $hh; $$_day = 1; $$_month = 1; $$_year = 1; return DateCalc_add_delta_days($_year,$_month,$_day,$dd); } sub DateCalc_easter_sunday { ##**************************************************************## ## ## ## Gauss'sche Regel (Gaussian Rule) ## ## ================================ ## ## ## ## Quelle / Source: ## ## ## ## H. H. Voigt, "Abriss der Astronomie", Wissenschaftsverlag, ## ## Bibliographisches Institut, Seite 9. ## ## ## ##**************************************************************## my($_year,$_month,$_day) = @_; my($a,$b,$c,$d,$e,$m,$n); return 0 if (($$_year < 1583) or ($$_year > 2299)); if ($$_year < 1700) { $m = 22; $n = 2; } elsif ($$_year < 1800) { $m = 23; $n = 3; } elsif ($$_year < 1900) { $m = 23; $n = 4; } elsif ($$_year < 2100) { $m = 24; $n = 5; } elsif ($$_year < 2200) { $m = 24; $n = 6; } else { $m = 25; $n = 0; } $a = $$_year % 19; $b = $$_year % 4; $c = $$_year % 7; $d = (19 * $a + $m) % 30; $e = (2 * $b + 4 * $c + 6 * $d + $n) % 7; $$_day = 22 + $d + $e; $$_month = 3; if ($$_day > 31) { $$_day -= 31; ## same as $$_day = $d + $e - 9; ## ${$_month}++; } $$_day = 19 if (($$_day == 26) and ($$_month == 4)); $$_day = 18 if (($$_day == 25) and ($$_month == 4) and ($d == 28) and ($e == 6) and ($a > 10)); return 1; } ## Carnival Monday / Rosenmontag / Veille du Mardi Gras = easter sunday - 48 ## ## Mardi Gras / Karnevalsdienstag / Mardi Gras = easter sunday - 47 ## ## Ash Wednesday / Aschermittwoch / Mercredi des Cendres = easter sunday - 46 ## ## Palm Sunday / Palmsonntag / Dimanche des Rameaux = easter sunday - 7 ## ## Easter Friday / Karfreitag / Vendredi Saint = easter sunday - 2 ## ## Easter Saturday / Ostersamstag / Samedi de Paques = easter sunday - 1 ## ## Easter Monday / Ostermontag / Lundi de Paques = easter sunday + 1 ## ## Ascension of Christ / Christi Himmelfahrt / Ascension = easter sunday + 39 ## ## Whitsunday / Pfingstsonntag / Dimanche de Pentecote = easter sunday + 49 ## ## Whitmonday / Pfingstmontag / Lundi de Pentecote = easter sunday + 50 ## ## Feast of Corpus Christi / Fronleichnam / Fete-Dieu = easter sunday + 60 ## sub DateCalc_Decode_Month ## 0 = error ## { my($string,$lang) = @_; my($length,$buffer,$month,$ok,$m); $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)); $length = length($string); $buffer = DateCalc_ISO_UC($string); $month = 0; $ok = 0; MONTH: for ( $m = 1; $m <= 12; $m++ ) { next MONTH if ($length > length($DateCalc_Month_to_Text_[$lang][$m])); next MONTH if (DateCalc_ISO_UC(substr($DateCalc_Month_to_Text_[$lang][$m],0,$length)) ne $buffer); if ($month > 0) { $ok = 0; last MONTH; } else { $ok = 1; $month = $m; } } return $month if ($ok); return 0; } sub DateCalc_Decode_Day_of_Week ## 0 = error ## { my($string,$lang) = @_; my($length,$buffer,$dow,$ok,$d); $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)); $length = length($string); $buffer = DateCalc_ISO_UC($string); $dow = 0; $ok = 0; DAYOFWEEK: for ( $d = 1; $d <= 7; $d++ ) { next DAYOFWEEK if ($length > length($DateCalc_Day_of_Week_to_Text_[$lang][$d])); next DAYOFWEEK if (DateCalc_ISO_UC(substr($DateCalc_Day_of_Week_to_Text_[$lang][$d],0,$length)) ne $buffer); if ($dow > 0) { $ok = 0; last DAYOFWEEK; } else { $ok = 1; $dow = $d; } } return $dow if ($ok); return 0; } sub DateCalc_Decode_Language ## 0 = error ## { my($string) = $_[0]; my($length,$buffer,$lang,$ok,$l); $length = length($string); $buffer = DateCalc_ISO_UC($string); $lang = 0; $ok = 0; LANGUAGE: for ( $l = 1; $l <= $DateCalc_LANGUAGES; $l++ ) { next LANGUAGE if ($length > length($DateCalc_Language_to_Text_[$l])); next LANGUAGE if (DateCalc_ISO_UC(substr($DateCalc_Language_to_Text_[$l],0,$length)) ne $buffer); if ($lang > 0) { $ok = 0; last LANGUAGE; } else { $ok = 1; $lang = $l; } } return $lang if ($ok); return 0; } sub DateCalc_decode_date_eu { my($string,$_year,$_month,$_day,$lang) = @_; my($length,$buffer,$i,$j); $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)); $$_year = $$_month = $$_day = 0; return 0 unless ($length = length($string)); $buffer = 0; $i = 0; while (DateCalc_scan9($string,$buffer,$length,$i,1)) { $i++; } $j = $length-1; while (DateCalc_scan9($string,$buffer,$length,$j,1)) { $j--; } if ($i+1 < $j) ## at least 3 chars, else error! ## { $buffer += $i; $length = $j-$i+1; $i = 1; while (DateCalc_scan9($string,$buffer,$length,$i,0)) { $i++; } $j = $length-2; while (DateCalc_scan9($string,$buffer,$length,$j,0)) { $j--; } if ($j < $i) ## only numerical chars without delimiters ## { if ($length == 3) { $$_day = substr($string,$buffer, 1); $$_month = substr($string,$buffer+1,1); $$_year = substr($string,$buffer+2,1); } elsif ($length == 4) { $$_day = substr($string,$buffer, 1); $$_month = substr($string,$buffer+1,1); $$_year = substr($string,$buffer+2,2); } elsif ($length == 5) { $$_day = substr($string,$buffer, 1); $$_month = substr($string,$buffer+1,2); $$_year = substr($string,$buffer+3,2); } elsif ($length == 6) { $$_day = substr($string,$buffer, 2); $$_month = substr($string,$buffer+2,2); $$_year = substr($string,$buffer+4,2); } elsif ($length == 7) { $$_day = substr($string,$buffer, 1); $$_month = substr($string,$buffer+1,2); $$_year = substr($string,$buffer+3,4); } elsif ($length == 8) { $$_day = substr($string,$buffer, 2); $$_month = substr($string,$buffer+2,2); $$_year = substr($string,$buffer+4,4); } else { return 0; } } else ## at least one non-numerical char (i <= j) ## { $$_day = substr($string,$buffer,$i); $$_year = substr($string,$buffer+($j+1),$length-($j+1)); while (DateCalc_scanx($string,$buffer,$length,$i,1)) { $i++; } while (DateCalc_scanx($string,$buffer,$length,$j,1)) { $j--; } if ($i <= $j) ## at least one char left for month ## { $buffer += $i; $length = $j-$i+1; $i = 1; while (DateCalc_scanx($string,$buffer,$length,$i,0)) { $i++; } if ($i >= $length) ## ok, no more delimiters ## { $i = 0; while (DateCalc_scan9($string,$buffer,$length,$i,0)) { $i++; } if ($i >= $length) ## only digits for month ## { $$_month = substr($string,$buffer,$length); } else ## match with month names ## { $$_month = DateCalc_Decode_Month(substr($string,$buffer,$length),$lang); } } else { return 0; } ## delimiters inside month string ## } else { return 0; } ## no chars left for month ## } ## at least one non-numerical char (i <= j) ## } else { return 0; } ## less than 3 chars in buffer ## $$_year = DateCalc_Moving_Window($$_year); return DateCalc_check_date($$_year,$$_month,$$_day); } sub DateCalc_decode_date_us { my($string,$_year,$_month,$_day,$lang) = @_; my($length,$buffer,$i,$j,$k); $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)); $$_year = $$_month = $$_day = 0; return 0 unless ($length = length($string)); { $buffer = 0; $i = 0; while (DateCalc_scanx($string,$buffer,$length,$i,1)) { $i++; } $j = $length-1; while (DateCalc_scan9($string,$buffer,$length,$j,1)) { $j--; } if ($i+1 < $j) ## at least 3 chars, else error! ## { $buffer += $i; $length = $j-$i+1; $i = 1; while (DateCalc_scanx($string,$buffer,$length,$i,0)) { $i++; } $j = $length-2; while (DateCalc_scan9($string,$buffer,$length,$j,0)) { $j--; } if ($i >= $length) ## only alphanumeric chars left ## { if ($j < 0) ## case 0 : xxxx999999xxxx ## { ## j0 i ## if ($length == 3) { $$_month = substr($string,$buffer, 1); $$_day = substr($string,$buffer+1,1); $$_year = substr($string,$buffer+2,1); } elsif ($length == 4) { $$_month = substr($string,$buffer, 1); $$_day = substr($string,$buffer+1,1); $$_year = substr($string,$buffer+2,2); } elsif ($length == 5) { $$_month = substr($string,$buffer, 1); $$_day = substr($string,$buffer+1,2); $$_year = substr($string,$buffer+3,2); } elsif ($length == 6) { $$_month = substr($string,$buffer, 2); $$_day = substr($string,$buffer+2,2); $$_year = substr($string,$buffer+4,2); } elsif ($length == 7) { $$_month = substr($string,$buffer, 1); $$_day = substr($string,$buffer+1,2); $$_year = substr($string,$buffer+3,4); } elsif ($length == 8) { $$_month = substr($string,$buffer, 2); $$_day = substr($string,$buffer+2,2); $$_year = substr($string,$buffer+4,4); } else { return 0; } } else ## case 1 : xxxxAAA999999xxxx ## { ## 0 j i ## $$_month = DateCalc_Decode_Month(substr($string,$buffer,$j+1),$lang); $buffer += $j+1; $length -= $j+1; if ($length == 2) { $$_day = substr($string,$buffer, 1); $$_year = substr($string,$buffer+1,1); } elsif ($length == 3) { $$_day = substr($string,$buffer, 1); $$_year = substr($string,$buffer+1,2); } elsif ($length == 4) { $$_day = substr($string,$buffer, 2); $$_year = substr($string,$buffer+2,2); } elsif ($length == 5) { $$_day = substr($string,$buffer, 1); $$_year = substr($string,$buffer+1,4); } elsif ($length == 6) { $$_day = substr($string,$buffer, 2); $$_year = substr($string,$buffer+2,4); } else { return 0; } } } ## 0 i j l ## else ## case 2 : xxxxAAAxxxx9999xxxx _OR_ ## { ## case 3 : xxxxAAAxx99xx9999xx ## $k = 0; ## 0 i j l ## while (DateCalc_scan9($string,$buffer,$length,$k,0)) { $k++; } if ($k >= $i) ## ok, only digits ## { $$_month = substr($string,$buffer,$i); } else ## no, some non-digits ## { $$_month = DateCalc_Decode_Month(substr($string,$buffer,$i),$lang); if ($$_month == 0) { return 0; } } $buffer += $i; $length -= $i; $j -= $i; $k = $j+1; ## remember start position of day+year(2)/year(3) ## $i = 1; while (DateCalc_scanx($string,$buffer,$length,$i,1)) { $i++; } $j--; while (DateCalc_scan9($string,$buffer,$length,$j,1)) { $j--; } if ($j < $i) ## case 2 : xxxxAAAxxxx9999xxxx ## { ## j0 i l ## $buffer += $k; ## k ## $length -= $k; if ($length == 2) { $$_day = substr($string,$buffer, 1); $$_year = substr($string,$buffer+1,1); } elsif ($length == 3) { $$_day = substr($string,$buffer, 1); $$_year = substr($string,$buffer+1,2); } elsif ($length == 4) { $$_day = substr($string,$buffer, 2); $$_year = substr($string,$buffer+2,2); } elsif ($length == 5) { $$_day = substr($string,$buffer, 1); $$_year = substr($string,$buffer+1,4); } elsif ($length == 6) { $$_day = substr($string,$buffer, 2); $$_year = substr($string,$buffer+2,4); } else { return 0; } } else ## case 3 : xxxxAAAxx99xx9999xx ## { ## 0 ij k l ## $$_year = substr($string,$buffer+$k,$length-$k); $k = $i; while (DateCalc_scan9($string,$buffer,$length,$k,0)) { $k++; } if ($k > $j) ## ok, only digits ## { $$_day = substr($string,$buffer+$i,$j-$i+1); } else { return 0; } ## non-digits inside day ## } } ## i < length ## } else { return 0; } ## less than 3 chars in buffer ## } $$_year = DateCalc_Moving_Window($$_year); return DateCalc_check_date($$_year,$$_month,$$_day); } sub DateCalc_Fixed_Window { my($year) = $_[0]; return 0 if ($year < 0); if ($year < 100) { $year += 100 if ($year < $DateCalc_YEAR_OF_EPOCH); $year += $DateCalc_CENTURY_OF_EPOCH; } return $year; } sub DateCalc_Moving_Window { my($year) = $_[0]; my($seconds,$current,$century); return 0 if ($year < 0); if ($year < 100) { if (($seconds = time()) >= 0) { $current = (gmtime($seconds))[5] + 1900; $century = int($current / 100); $year += $century * 100; if ($year < $current - 50) { $year += 100; } elsif ($year >= $current + 50) { $year -= 100; } } else { $year = DateCalc_Fixed_Window($year); } } return $year; } sub DateCalc_Compress { my($year,$month,$day) = @_; my($yy); if (($year >= $DateCalc_EPOCH) and ($year < ($DateCalc_EPOCH + 100))) { $yy = $year; $year -= $DateCalc_EPOCH; } else { return 0 if (($year < 0) or ($year > 99)); if ($year < $DateCalc_YEAR_OF_EPOCH) { $yy = $DateCalc_CENTURY_OF_EPOCH + 100 + $year; $year += 100 - $DateCalc_YEAR_OF_EPOCH; } else { $yy = $DateCalc_CENTURY_OF_EPOCH + $year; $year -= $DateCalc_YEAR_OF_EPOCH; } } return 0 if (($month < 1) or ($month > 12)); return 0 if (($day < 1) or ($day > $DateCalc_Days_in_Month_[DateCalc_leap_year($yy)][$month])); return ($year << 9) | ($month << 5) | $day; } sub DateCalc_uncompress { my($date,$_century,$_year,$_month,$_day) = @_; if ($date > 0) { $$_year = $date >> 9; $$_month = ($date & 0x01FF) >> 5; $$_day = $date & 0x001F; if ($$_year < 100) { if ($$_year < 100-$DateCalc_YEAR_OF_EPOCH) { $$_century = $DateCalc_CENTURY_OF_EPOCH; $$_year += $DateCalc_YEAR_OF_EPOCH; } else { $$_century = $DateCalc_CENTURY_OF_EPOCH+100; $$_year -= 100-$DateCalc_YEAR_OF_EPOCH; } return DateCalc_check_date($$_century+$$_year,$$_month,$$_day); } } return 0; } sub DateCalc_check_compressed { my($century,$year,$month,$day); return DateCalc_uncompress($_[0],\$century,\$year,\$month,\$day); } sub DateCalc_Compressed_to_Text { my($date,$lang) = @_; my($century,$year,$month,$day,$string); $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)); if (DateCalc_uncompress($date,\$century,\$year,\$month,\$day)) { $string = sprintf("%02d-%.3s-%02d",$day,$DateCalc_Month_to_Text_[$lang][$month],$year); } else { $string = '??-???-??'; } return $string; } sub DateCalc_Date_to_Text { my($year,$month,$day,$lang) = @_; $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)); if (DateCalc_check_date($year,$month,$day)) { if ($DateCalc_Day_of_Week_Abbreviation_[$lang][0] ne '') { return sprintf("%.3s %d-%.3s-%d", $DateCalc_Day_of_Week_Abbreviation_[$lang][DateCalc_Day_of_Week($year,$month,$day)], $day,$DateCalc_Month_to_Text_[$lang][$month],$year); } else { return sprintf("%.3s %d-%.3s-%d", $DateCalc_Day_of_Week_to_Text_[$lang][DateCalc_Day_of_Week($year,$month,$day)], $day,$DateCalc_Month_to_Text_[$lang][$month],$year); } } return undef; } sub DateCalc_English_Ordinal { my($result) = "$_[0]"; my($length,$digit); if (($length = length($result)) > 0) { $digit = 0 unless ( ( (($length > 1) and (substr($result,$length-2,1) ne '1')) or ($length == 1) ) and ( ($digit = substr($result,$length-1,1)) <= 3 ) ); $result .= $DateCalc_English_Ordinals_[$digit]; } return $result; } sub DateCalc_Date_to_Text_Long { my($year,$month,$day,$lang) = @_; my($string,$buffer); $lang = $DateCalc_Language if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)); if (DateCalc_check_date($year,$month,$day)) { if ($lang == 1) { return sprintf ( $DateCalc_Date_Long_Format_[$lang], $DateCalc_Day_of_Week_to_Text_[$lang] [DateCalc_Day_of_Week($year,$month,$day)], $DateCalc_Month_to_Text_[$lang][$month], DateCalc_English_Ordinal($day), $year ); } elsif ($lang == 12) { return sprintf ( $DateCalc_Date_Long_Format_[$lang], $year, $DateCalc_Month_to_Text_[$lang][$month], $day, $DateCalc_Day_of_Week_to_Text_[$lang] [DateCalc_Day_of_Week($year,$month,$day)] ); } else { return sprintf ( $DateCalc_Date_Long_Format_[$lang], $DateCalc_Day_of_Week_to_Text_[$lang] [DateCalc_Day_of_Week($year,$month,$day)], $day, $DateCalc_Month_to_Text_[$lang][$month], $year ); } } return undef; } sub DateCalc_Calendar { my($year,$month,$orthodox,$lang) = @_; my($string,$cursor,$buffer,$first,$last,$day); if (($lang < 1) or ($lang > $DateCalc_LANGUAGES)) { $lang = $DateCalc_Language; } $string = ''; $cursor = \$string; DateCalc_Newline($cursor,1); $buffer = sprintf("%s %d", DateCalc_ISO_UC_First($DateCalc_Month_to_Text_[$lang][$month]), $year); DateCalc_Center($cursor,$buffer,27); if ($DateCalc_Day_of_Week_Abbreviation_[$lang][0] ne '') { if ($orthodox) { $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n", $DateCalc_Day_of_Week_Abbreviation_[$lang][7], $DateCalc_Day_of_Week_Abbreviation_[$lang][1], $DateCalc_Day_of_Week_Abbreviation_[$lang][2], $DateCalc_Day_of_Week_Abbreviation_[$lang][3], $DateCalc_Day_of_Week_Abbreviation_[$lang][4], $DateCalc_Day_of_Week_Abbreviation_[$lang][5], $DateCalc_Day_of_Week_Abbreviation_[$lang][6]); } else ## conform to ISO standard ## { $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n", $DateCalc_Day_of_Week_Abbreviation_[$lang][1], $DateCalc_Day_of_Week_Abbreviation_[$lang][2], $DateCalc_Day_of_Week_Abbreviation_[$lang][3], $DateCalc_Day_of_Week_Abbreviation_[$lang][4], $DateCalc_Day_of_Week_Abbreviation_[$lang][5], $DateCalc_Day_of_Week_Abbreviation_[$lang][6], $DateCalc_Day_of_Week_Abbreviation_[$lang][7]); } } else { if ($orthodox) { $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n", $DateCalc_Day_of_Week_to_Text_[$lang][7], $DateCalc_Day_of_Week_to_Text_[$lang][1], $DateCalc_Day_of_Week_to_Text_[$lang][2], $DateCalc_Day_of_Week_to_Text_[$lang][3], $DateCalc_Day_of_Week_to_Text_[$lang][4], $DateCalc_Day_of_Week_to_Text_[$lang][5], $DateCalc_Day_of_Week_to_Text_[$lang][6]); } else ## conform to ISO standard ## { $string .= sprintf("%3.3s %3.3s %3.3s %3.3s %3.3s %3.3s %3.3s\n", $DateCalc_Day_of_Week_to_Text_[$lang][1], $DateCalc_Day_of_Week_to_Text_[$lang][2], $DateCalc_Day_of_Week_to_Text_[$lang][3], $DateCalc_Day_of_Week_to_Text_[$lang][4], $DateCalc_Day_of_Week_to_Text_[$lang][5], $DateCalc_Day_of_Week_to_Text_[$lang][6], $DateCalc_Day_of_Week_to_Text_[$lang][7]); } } $first = DateCalc_Day_of_Week($year,$month,1); $last = $DateCalc_Days_in_Month_[DateCalc_leap_year($year)][$month]; if ($orthodox) { $first = 0 if ($first == 7); } else { $first--; } if ($first) { DateCalc_Blank($cursor,($first<<2)-1); } for ( $day = 1; $day <= $last; $day++, $first++ ) { if ($first > 0) { if ($first > 6) { $first = 0; DateCalc_Newline($cursor,1); } else { DateCalc_Blank($cursor,1); } } $string .= sprintf(" %2d",$day); } DateCalc_Newline($cursor,2); return $string; } ############### ## ## ## Calc.pm ## ## ## ############### sub Decode_Date_EU2 { croak "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2)); my($buffer) = shift; my($lang) = shift || 0; my($year,$month,$day,$length); $lang = Language() unless (($lang >= 1) and ($lang <= Languages())); if ($buffer =~ /^\D* (\d+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D*$/x) { ($day,$month,$year) = ($1,$2,$3); $month = Decode_Month($month,$lang); unless ($month > 0) { return(); # can't decode month! } } elsif ($buffer =~ /^\D* 0*(\d+) \D*$/x) { $buffer = $1; $length = length($buffer); if ($length == 3) { $day = substr($buffer,0,1); $month = substr($buffer,1,1); $year = substr($buffer,2,1); } elsif ($length == 4) { $day = substr($buffer,0,1); $month = substr($buffer,1,1); $year = substr($buffer,2,2); } elsif ($length == 5) { $day = substr($buffer,0,1); $month = substr($buffer,1,2); $year = substr($buffer,3,2); } elsif ($length == 6) { $day = substr($buffer,0,2); $month = substr($buffer,2,2); $year = substr($buffer,4,2); } elsif ($length == 7) { $day = substr($buffer,0,1); $month = substr($buffer,1,2); $year = substr($buffer,3,4); } elsif ($length == 8) { $day = substr($buffer,0,2); $month = substr($buffer,2,2); $year = substr($buffer,4,4); } else { return(); } # wrong number of digits! } elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x) { ($day,$month,$year) = ($1,$2,$3); } else { return(); } # no match at all! $year = Moving_Window($year); if (check_date($year,$month,$day)) { return($year,$month,$day); } else { return(); } # not a valid date! } sub Decode_Date_US2 { croak "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2)); my($buffer) = shift; my($lang) = shift || 0; my($year,$month,$day,$length); $lang = Language() unless (($lang >= 1) and ($lang <= Languages())); if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* 0*(\d+) \D*$/x) { ($month,$buffer) = ($1,$2); $month = Decode_Month($month,$lang); unless ($month > 0) { return(); # can't decode month! } $length = length($buffer); if ($length == 2) { $day = substr($buffer,0,1); $year = substr($buffer,1,1); } elsif ($length == 3) { $day = substr($buffer,0,1); $year = substr($buffer,1,2); } elsif ($length == 4) { $day = substr($buffer,0,2); $year = substr($buffer,2,2); } elsif ($length == 5) { $day = substr($buffer,0,1); $year = substr($buffer,1,4); } elsif ($length == 6) { $day = substr($buffer,0,2); $year = substr($buffer,2,4); } else { return(); } # wrong number of digits! } elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D+ (\d+) \D*$/x) { ($month,$day,$year) = ($1,$2,$3); $month = Decode_Month($month,$lang); unless ($month > 0) { return(); # can't decode month! } } elsif ($buffer =~ /^\D* 0*(\d+) \D*$/x) { $buffer = $1; $length = length($buffer); if ($length == 3) { $month = substr($buffer,0,1); $day = substr($buffer,1,1); $year = substr($buffer,2,1); } elsif ($length == 4) { $month = substr($buffer,0,1); $day = substr($buffer,1,1); $year = substr($buffer,2,2); } elsif ($length == 5) { $month = substr($buffer,0,1); $day = substr($buffer,1,2); $year = substr($buffer,3,2); } elsif ($length == 6) { $month = substr($buffer,0,2); $day = substr($buffer,2,2); $year = substr($buffer,4,2); } elsif ($length == 7) { $month = substr($buffer,0,1); $day = substr($buffer,1,2); $year = substr($buffer,3,4); } elsif ($length == 8) { $month = substr($buffer,0,2); $day = substr($buffer,2,2); $year = substr($buffer,4,4); } else { return(); } # wrong number of digits! } elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x) { ($month,$day,$year) = ($1,$2,$3); } else { return(); } # no match at all! $year = Moving_Window($year); if (check_date($year,$month,$day)) { return($year,$month,$day); } else { return(); } # not a valid date! } sub Parse_Date { croak "Usage: (\$year,\$month,\$day) = Parse_Date(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2)); my($date) = shift; my($lang) = shift || 0; my($year,$month,$day); $lang = Language() unless (($lang >= 1) and ($lang <= Languages())); unless ($date =~ /\b([\x41-\x5A\x61-\x7A\xC0-\xD6\xD8-\xF6\xF8-\xFF]{3})\s+([0123]??\d)\b/) { return(); } $month = $1; $day = $2; unless ($date =~ /\b(19\d\d|20\d\d)\b/) { return(); } $year = $1; $month = Decode_Month($month,$lang); unless ($month > 0) { return(); } unless (check_date($year,$month,$day)) { return(); } return($year,$month,$day); } 1; __END__