Date-Calc-6.3/000755 100660 100660 00000000000 11272757315 012163 5ustar00sbsb000000 000000 Date-Calc-6.3/MANIFEST000644 100660 100660 00000001652 11272757315 013320 0ustar00sbsb000000 000000 CHANGES.txt CREDITS.txt lib/Date/Calc.pm lib/Date/Calc.pod lib/Date/Calc/Object.pm lib/Date/Calc/Object.pod lib/Date/Calc/PP.pm lib/Date/Calc/PP.pod lib/Date/Calendar.pm lib/Date/Calendar.pod lib/Date/Calendar/Profiles.pm lib/Date/Calendar/Profiles.pod lib/Date/Calendar/Year.pm lib/Date/Calendar/Year.pod license/Artistic.txt license/GNU_GPL.txt license/GNU_LGPL.txt Makefile.PL MANIFEST README.txt t/f000.t t/f001.t t/f002.t t/f003.t t/f004.t t/f005.t t/f006.t t/f007.t t/f008.t t/f009.t t/f010.t t/f011.t t/f012.t t/f013.t t/f014.t t/f015.t t/f016.t t/f017.t t/f018.t t/f019.t t/f020.t t/f021.t t/f022.t t/f023.t t/f024.t t/f025.t t/f026.t t/f027.t t/f028.t t/f029.t t/f030.t t/f031.t t/f032.t t/f033.t t/f034.t t/f035.t t/f036.t t/f037.t t/m001.t t/m002.t t/m003.t t/m004.t t/m005.t t/m006.t t/m007.t t/m008.t t/m009.t t/m010.t t/m011.t t/m012.t t/m013.t META.yml Module meta-data (added by MakeMaker) Date-Calc-6.3/lib/000755 100660 100660 00000000000 11272757315 012731 5ustar00sbsb000000 000000 Date-Calc-6.3/CREDITS.txt000644 100660 100660 00000047535 11272757315 014037 0ustar00sbsb000000 000000 ==================================== Package "Date::Calc" Version 6.3 ==================================== Copyright (c) 1995 - 2009 by Steffen Beyer. All rights reserved. Credits: -------- Many thanks to Andreas Koenig for his efforts as upload-manager for the CPAN, his patience, and lots of very good advice and suggestions! Thank you for doing such a tremendous (and very time-consuming) job!! Also many thanks to David Jenkins for reviewing the first version of this README file and the english man page. Thanks to Jarkko Hietaniemi for suggesting the "days_in_month()" function. Many thanks to Christian for reporting the bug fixed in version 1.4, which showed up on an HP E55 running HP-UX 10.01 and Perl 5.001m with the c89 Ansi 89 compiler from HP. Also many thanks to David Thompson for reporting a problem he encountered concerning the inclusion of the Perl distribution ("Unable to find include file ...") and for suggesting a solution for this problem. (That's the most pleasant kind of problem report, of course! ;-) ) Many thanks to Tom Limoncelli for raising the question of how to calculate the 2nd Thursday of a given month and year! Many thanks to Bart Robinson for suggesting the "all" export option and the "decode_day()" and "decode_month()" functions. Also many thanks to Ron Savage for suggesting the incorporation of time calculations into this module. (Sorry that I didn't include the handling of time zones, which can be taken care of more easily by adding/subtracting the appropriate time value in an extra, preliminary step!) Many thanks to Jonathan Lemon for reporting the bug (and how to fix it!) concerning arrays as parameters, fixed in version 2.2! Many thanks to Tim Zingelman for reporting the problem fixed in version 2.3 and for testing an intermediate new version of this module on his machine! Many thanks to Jonas Liljegren for posting a subroutine for calculating easter monday in news:comp.lang.perl.modules and thereby triggering my writing of the new "Date::CalcLib" module which has been added in version 3.0 of the "Date::Calc" distribution. Also many thanks to Claus Tondering for his excellent web pages and FAQ in news:news.answers about calendars and how to calcu- late easter sunday. Thanks to Reinhold Stansich for posting a list of christian feast days and their offsets from easter sunday in news: comp.databases.ms-access and to Tammo Schnieder for sending me his posting. Many thanks to Max Ruffert at the Max Planck Institute for Astrophysics in Garching for looking up Gauss' Rule for calculating easter sunday (the algorithm which is implemented in the "Date::CalcLib" module) for me and dictating it to me over the phone! Many thanks to Chris Halverson for asking me "is there a "standard" way to create a calendar similar to the output of cal(1)?", which gave me the idea to write the function "calendar" which has been added to the module "DateCalcLib" in version 3.1, and also for the C code demonstrating how to use the C library "lib_date.c" stand-alone, because that was what he needed to do as well. Many thanks to Gunardi Wu for notifying me about the bug in the "Add_Delta_YMD()" function which was fixed in version 4.1. Thanks to the several people who notified me about two compiler warnings concerning incompatible character types in Calc.xs line 857 (added two casts in version 4.2 to fix this flaw). Many thanks to Alessio Bragadini for the patch he sent in to add Italian as one of the supported languages (version 4.3). Many thanks to Roland Titze and to Andrew Brown for pointing out the misspelling of "whether" (was: wether) throughout my documentation, corrected in version 5.0. Special thanks go to Tim Mueller-Seydlitz for notifying me about the inability of all string decoding routines to parse special ISO-Latin-1 characters correctly. Many thanks to Gisle Aas for many good suggestions and his patch for adding support for Norwegian. Many thanks to Jerker Nilsson for his patch for adding Swedish. Also many thanks to Masanao Izumo for raising the question of a "Delta_YMD()" function and for sending in patches. And last but not least many thanks to Slaven Rezic , Tobias Brox and Matthew Persico for suggesting date objects with overloaded operators, which were added in version 5.0. Many thanks to Tobias Brox again for the idea of supplying one set of comparison operators which compare only the date part, and another set of operators which compare date and time (or fall back to comparing only the date if both operands lack the time part). Many thanks to Jens Coldewey , Michael Niebler and Charles Lane for notifying me about the missing "#include " statement in DateCalc.c. Also many thanks to Frank Dabelstein for his patch for adding Danish. Thanks also go to Steve Tolkin for suggesting that I should emphasize in the README.txt file that the reading of the INSTALL.txt file is important, especially if running Perl under Windows. :-) Many thanks to Martin Vorlaender for notifying me about the problem with the linker on VMS with identifiers longer than 30 characters, and to Charles Lane for sending me a patch! Many thanks to Jarkko Hietaniemi for providing me with the necessary information to add Finnish (suomi). Many thanks to Graham Barr for his many good suggestions regarding how to generalize my original, very limited module (based on Carp.pm) which skips all packages belonging to the "Date::*" hierarchy (in order to generate an error message from the perspective of the caller), into a module that can be given a pattern (i.e., a regular expression) of package names to be skipped. Also many thanks for his suggestions of a name for this module and for lots of great code he sent! Also many many thanks to the innumerable contributors of the lists of American states and abbreviations and many countries' national holidays: List of U.S. American states and abbreviations courtesy of: Jack Applin Troy Arnold Larry Rosler Mark-Jason Dominus Charles Ford URLs concerning U.S. American states and abbreviations thereof sent by: Edward Cerruti Mark Badolato List of Canadian states and abbreviations courtesy of: Larry Rosler Geoff Baskwill List of U.S. American holidays courtesy of: David Cassell Larry Rosler Anthony Argyriou List of Canadian holidays courtesy of: M Lyons List of Norwegian holidays courtesy of: Gisle Aas (From his module "No::Dato" on CPAN) List of Swedish holidays courtesy of: Erland Sommarskog List of British holidays courtesy of: Jonathan Stowe Lists, hints, suggestions and URLs concerning different countries' holidays were sent to me by: Jihad Battikha Tim Rueger Mark-Jason Dominus Abe Timmerman Troy Arnold Mattias Engdegĺrd Lincoln Yeoh Bart Lateur David Chapman Russ Allbery Ben Coleman Wolfgang Franzki Rainer Gratias Thanks to Nelson Ferrari for suggesting an alternative "Calendar()" function which starts on Sunday instead of Monday. Many thanks again to Martin Vorlaender for testing my modifications in order to satisfy the VMS linker (which was complaining about identifiers which were longer than 30 characters) and for his confirmation that now everything works (not counting some innocuous warnings from xsubpp)! Thanks a lot to Ramiro Morales for correcting my errors in Spanish (and for sending a patch)! And last but not least, many very special thanks for his tremendous work to J. David Eisenberg for writing a plain Perl version of Date::Calc 4.3, available from his home page at http://catcode.com/date/pcalc.html! (And also from my web site at http://www.engelschall.com/u/sb/download/ and my CPAN directory at http://www.perl.com/CPAN/authors/id/S/ST/STBEY/.) Many extra thanks to Bianca Taylor for exploring the mysteries of (and phoning up a lot of astounded state officials!) the australian holidays for me, as well as for sending me a list with the holidays of New Zealand; and many thanks also to her friend John Bolland for compiling this list for New Zealand in the first place! Many thanks to ??? ??? for sending me excellent feedback and suggestions. He for instance suggested the possibility to have individual formatting for different date objects, and the ability to import/export Unix "time" values. Many special thanks (k) to my girlfriend Ana Maria Lopes Monteiro for investigating the brazilian holidays and commemorative days for me! Very special thanks to the following people for helping in compiling and verifying the calendar profiles in Date::Calendar::Profiles: Abe Timmerman Abigail Aldo Calpini Andie Posey Arnaud Calvo Arturo Valdes Bart Lateur Brian Graham Bruno Tavares Cas Tuyn Cedric Bouvier David Landgren Dietmar Rietsch Don Simonetta Elizabeth Mattijsen Erland Sommarskog Flemming Mahler Larsen Francois Desarmenien Gordon Fletcher H. Merijn Brand Hendrik Van Belleghem Herbert Liechti Jean Forget Jigal van Hemert Johan Vromans Julien Quint Lars Ole Magnus Bodin Marco Hunn Mark Keehn Michele Beltrame Pat Waters Paul Fenwick Peter G. Martin Remco B. Brink Robert McArthur Stefaan Colson Stephane Rondal Wim Verhaegen Jabu Virginia Duma, Giant's Castle Lodge, Drakensberg, 3310 Estcourt, KwaZulu-Natal, South Africa Dirk Swart Hilda de Jager Hennie Meyer Pe. Amancio Inez Hiltrop Stephen Riehm Graham Crookham Philip Newton Many thanks to Sunny Paris for correcting the french date format in function "Date_to_Text_Long()"! Many grateful thanks to Nathaniel Irons for reporting a problem and for testing a possible solution on his machine regarding the inclusion of the file "patchlevel.h"! Many thanks to Daniel Crown for providing me with a list of argentinian holidays! Many thanks to Morten Sickel for reporting why Excel (erroneously) regards 1900 as a leap year, and why therefore one should use 31-Dec-1899 as the epoch for converting Excel date values. Many thanks to Georg Mavridis for providing me with the list of greek holidays. Many thanks also to Guenther Degenfelder for showing me his "Karl" calendar display program, which inspired me to write the example script "anniversaries.pl" (in the "examples" subdirectory of this distribution). Many special thanks to Thomas Wegner for porting version 5.0 of this module to MacOS and MacPerl. His port (plus some additions - see below) is now version 5.1. Thanks to Ken Clarke for his addition to the documentation concerning the function "Monday_of_Week()". Many thanks to Nora Elia Castillo for sending me the list of holidays for Mexico! Thanks to dLux (Balázs Tibor Szabó) for his much simpler formula in recipe #4 in the "Date::Calc" documentation. Thanks to Daniel Berger for suggesting a normalization method for delta vectors in Date::Calc::Object, which has been added in version 5.1. Thanks to Danny Rathjens for suggesting the improvement in the documentation of Date::Calc concerning the paragraph which says that ALL ranges start with 1 - except, of course, hours, minutes and seconds. Many thanks to Dr. John Stockton for notifying me about some spelling, naming and historical errors in the documentation of Date::Calc, which have been corrected in version 5.1. Many thanks to Slawomir Szmyd for sending me the patch to add Polish and the profile of polish holidays. Many thanks to Robert Kovacs for sending me the patch for adding Hungarian. Many thanks to Simon Perreault for sending me corrections for the Quebec/Canada profile in Date::Calendar. Thanks to Sercan Uslu for sending me the dates of the turkish holidays in 2002. Thanks to Ivor Blockley for asking for a way to compare dates which have a time part, and how to test whether two such dates are more or less than a given time interval apart - the solution to this problem is now recipe #3 in the Date::Calc documentation. Many thanks to Ian Zapczynski and to Felix Geerinckx for notifying me about a bug in the method "add_delta_workdays()" (Date::Calendar), which sometimes causes an incorrect result when adding a negative number of workdays. The bug hasn't been fixed yet, but there is a workaround which seems to remedy the problem: First add one workday to the date in question, and then subtract one workday more than initially. Many thanks to Mike Swieton (and many other people in the past) for sending in a patch so that ToolBox.h will compile with C++ compilers. Thanks to Joe Rice and Sridhar Gopal for pointing out that the formula for Labor Day in the U.S. apparently was wrong; it returned September 8th in 2003 but Labor Day in that year actually was on September 1st. It should obviously be "1/Mon/Sep" instead. Many thanks to M.S. Tawfik for finding a bug in the "init()" method of Date::Calendar::Year when the year starts with a Sunday (such as in 1995) and for sending a patch! Thanks to George Cooke for raising the question of how to "normalize" the results of the "Delta_YMD()" function to show only positive values, the answer to which has been included as a "recipe" in the documentation of Date::Calc. Thanks to Joachim Ansorg for sending me the necessary information to add Romanian to the list of languages supported by Date::Calc. Many thanks to Peter Prymmer for suggesting a work-around for the problems that can arise when a locale other than "C" is used! Thanks to Olle E. Johansson for sending corrections for the Swedish calendar profile. Thanks to Harold van Oostrom for sending in a fix for the Polish language in Date::Calc. Also many thanks for his patch to make Date::Calc ready for UTF-8, which unfortunately I haven't had the time yet to evaluate. Many thanks also to Sven Geisler for sending me corrections for the profile and official references for ALL federal states of Australia. Many thanks to Tony Mountifield for sending in a patch to enable Date::Calc to handle negative values of time_t, for dates before the Epoch. I decided not to include it at this time first because the system functions such as localtime, gmtime and mktime are considered legacy functions due to their rather restricted range (Date::Calc's own functions operate on a much broader range), and second because it cost so much effort to make these functions work in Date::Calc under Unix and Windows as well as under MacOS (Classic), that the risk of breaking things is just too high, not to mention the time and effort needed to get it right again, which I can't spend at the moment, unfortunately. So please use Date::Calc's own functions instead, which cover the intended range of dates anyway. Thanks a lot to Can Bican , Ziya Suzen , Henk Uijterwaal and the Amsterdam Perl Mongers for providing me with more detailed information concerning the "Bevrijdingsdag" (5th of May) in the Netherlands. Many thanks to Vetle Roeim for sending some more commemorative days (some companies give half a day off) for the Norwegian profile. Thanks a lot to Jesse Vincent and to Alistair Francis for reporting the ongoing problem with the boolean type in MacOS X and to Tatsuhiko Miyagawa (?) and Alistair Francis for providing patches. Thanks to Thanos Chatziathanassiou along with Barret Clark and Qiang (?) for suggesting some changes to the documentation. Sorry for not including the changes concerning the Orthodox and Julian calendars since these are outside of the scope of this module. Thanks to Anthony DeRobertis and Jonathan Yu for alerting me about the problem that in Date::Calendar and Date::Calendar::Year, it is hardcoded that Saturday and Sunday are holidays, and for asking to make this configurable. Many thanks to H. Merijn Brand for triggering the development of a new normalized date difference function. Many thanks to Marek Snowarski for raising my attention to the fact that the Polish names for the months and days of week were written wrongly. Many thanks to Piotr Wierzejewski for providing me with the correct spelling of the Polish names for the months and days of week in Unicode. Many thanks to H.Merijn Brand for discussing the various issues and advantages/disadvantages of integrating versus splitting the C/XS-part and the pure-Perl part of this distribution with me! Many thanks to Anthony Mirante for reporting that there can be a difference in the output of "Date::Calc::PP::Mktime()", "Date::Calc::XS::Mktime()" and "POSIX::mktime()", and for running a test script for me! Date-Calc-6.3/META.yml000644 100660 100660 00000000746 11272757315 013443 0ustar00sbsb000000 000000 --- #YAML:1.0 name: Date-Calc version: 6.3 abstract: Gregorian calendar date calculations license: perl author: - Steffen Beyer generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: Bit::Vector: 7.1 Carp::Clan: 6.04 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 Date-Calc-6.3/Makefile.PL000644 100660 100660 00000003771 11272757315 014145 0ustar00sbsb000000 000000 #!perl -w ############################################################################### ## ## ## Copyright (c) 1995 - 2009 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. ## ## ## ############################################################################### use strict; use ExtUtils::MakeMaker; BEGIN { eval { require Config_m; }; # ExtUtils::FakeConfig (+ ActivePerl) eval { require Config; } # Everyone else if ($@); } print qq{\n}; print qq{*************************************************************\n}; print qq{****** BEWARE: Use "make install UNINST=1" to install! ******\n}; print qq{*************************************************************\n}; print qq{\n}; WriteMakefile( 'NAME' => 'Date::Calc', 'VERSION_FROM' => 'lib/Date/Calc.pm', 'ABSTRACT_FROM' => 'lib/Date/Calc.pod', 'LICENSE' => 'perl', 'AUTHOR' => 'Steffen Beyer ', 'PREREQ_PM' => { 'Carp::Clan' => 6.04, 'Bit::Vector' => 7.1 }, 'META_MERGE' => { 'recommends' => { 'Date::Calc::XS' => 6.2 } }, 'dist' => { COMPRESS => "gzip -9", SUFFIX => "gz" }, # for ActivePerl: ($] >= 5.005 && $^O eq 'MSWin32' && $Config::Config{'archname'} =~ /-object\b/i ? ('CAPI' => 'TRUE') : ()) ); __END__ Date-Calc-6.3/CHANGES.txt000644 100660 100660 00000040513 11272757315 013777 0ustar00sbsb000000 000000 ==================================== Package "Date::Calc" Version 6.3 ==================================== Copyright (c) 1995 - 2009 by Steffen Beyer. All rights reserved. Version history: ---------------- Version 6.3 31.10.2009 + Changed "Mktime()" to use "POSIX::mktime()" + Fixed the bug that "Date::Calc::PP" was never tested when "Date::Calc::XS" is installed Version 6.2 16.10.2009 + Split the "Date::Calc" distribution into a pure-Perl and a C/XS part Version 6.1 15.10.2009 + United "Date::Calc" and "Date::Pcalc" into a single distribution + Fixed Polish names of months and days of week (RT ticket #14159) Version 6.0 07.10.2009 + Added new functions "N_Delta_YMDHMS()", "Add_N_Delta_YMD()" and "Add_N_Delta_YMDHMS()" to "Date::Calc" + Added more tests to "t/f037.t" for these new functions + Added a new "normalized" mode to "Date::Calc::Object" which uses the new functions "N_Delta_YMD()", "N_Delta_YMDHMS()", "Add_N_Delta_YMD()" and "Add_N_Delta_YMDHMS()" + Added test scripts "t/m012.t" and "t/m013.t" for this new mode + The language can now be set individually for each function in "Date::Calc" that requires it (through a new optional parameter; the default continues to be a global setting for backward compatibility); the affected functions are: "Decode_Month()", "Decode_Day_of_Week()", "Compressed_to_Text()", "Date_to_Text()", "Date_to_Text_Long()", "Calendar()", "Month_to_Text()", "Day_of_Week_to_Text()", "Day_of_Week_Abbreviation()", "Decode_Date_EU()", "Decode_Date_US()", "Decode_Date_EU2()", "Decode_Date_US2()", "Parse_Date()". + BEWARE that the interface of "DateCalc.c" has changed! + Module "Date::Calc::Object" has been changed similarly + Module "Date::Calendar::Year" has also been adapted accordingly + Many test scripts have been changed to reflect the modifications in "Date::Calc", "Date::Calc::Object" and "Date::Calendar::Year" and more test cases have been added + Updated the documentation to reflect all changes + Updated version numbers of dependencies in "t/f000.t" Version 5.8 12.09.2009 + Added a new function "N_Delta_YMD()" + Added a new test script "t/f037.t" + Updated the "Calc.pod" manual page accordingly + Renamed "calendar.cgi" in the "examples" subdirectory to "calendar.pl" + Added a new CGI script named "datecalc.pl" to the "examples" subdirectory Version 5.7 23.08.2009 + Fixed "october" => "oktober" in Dutch + Disabled the special abbreviated names of the days of the week in Portuguese + Made the days which form the weekend con- figurable in "Calendar.pm" and "Year.pm" + Added some test cases for this new feature in "t/m008.t" + The file "examples/calendar.cgi" now also supports this new feature + Updated "README.txt" and "INSTALL.txt" and the dependency on "Bit::Vector" 7.0 + Added an additional "README.htm" file to this distribution highlighting its key points + Updated the documentation of "Date::Calc", "Date::Calendar", "Date::Calendar::Profiles", "Date::Calendar::Year" and "Date::Object" + See the new module "Date::Calc::Util" (which is available separately; to be released soon) for all the shortcuts you ever wanted to have in "Date::Calc" Version 5.6 28.07.2009 + Made the module MacOS X compatible + Made some tiny changes to the documentation Version 5.5 was skipped due to an unauthorized upload by someone else Version 5.4 03.10.2004 + Added compiler directives for C++. + Removed "Carp::Clan" from the distribution (available separately). + Fixed bug in initialization of "Date::Calendar::Year" objects. + Added method "tags()" to "Date::Calendar" and "Date::Calendar::Year". + Fixed the formula for "Labor Day" in the U.S. to "1/Mon/Sep". + Added a new recipe to the "Date::Calc" documentation. + Added Romanian to the list of languages supported by "Date::Calc". + Changed the example script "calendar.cgi" to highlight the name which led to a given date being a holiday. + Fixed the Polish entries in "Date::Calc". + Added a few commemorative days to the Norwegian calendar profile. + Added "use bytes" to all Perl files to avoid problems on systems not using the standard locale "C". + Fixed test 5 of t/m005.t to (hopefully) work under other locales. Version 5.3 29.09.2002 + Simplified the error message handlers in "Calc.xs". Version 5.2 18.09.2002 + Changed the Polish profiles from ISO-Latin-2 to ISO-Latin-1. + Fixed the broken tests in "t/f034.t" and "t/m006.t". + Synchronized "Carp::Clan" and "ToolBox.h" with "Bit::Vector" 6.2. Version 5.1 08.09.2002 + Integrated modifications needed for MacOS / MacPerl. + Added new method "normalize()" (Date::Calc::Object). + Added a new test script "t/m011.t" for "normalize()". + Added a calendar profile for Mexico (Date::Calendar::Profiles). + Little additions to and corrections of the documentation (Date::Calc). + Added Polish (Date::Calc) and a calendar profile for Poland. + Added Hungarian (Date::Calc). + Added some more commemorative days to the profile of Brazil. Version 5.0 10.10.2001 Module "Date::Calc": + Added the following new functions: * check_time() * Delta_YMD() * Delta_YMDHMS() * Add_Delta_YM() * Add_Delta_YMDHMS() * Normalize_DHMS() * This_Year() * Gmtime() * Localtime() * Mktime() * Timezone() * Date_to_Time() * Time_to_Date() * Fixed_Window() * Moving_Window() * ISO_LC() * ISO_UC() + Added support for Norwegian. + Added support for Swedish. + Added support for Danish. + Added support for Finnish. + Changed the month names of some languages to lower case. + Changed the french "long" date format to a more popular form. + Changed the corresponding test script (t/f012.t) accordingly. + Corrected the spanish texts in ./examples/age_in_days_*. + Fixed the broken parsing of special ISO-Latin-1 characters in Date::Calc (replaced with better solution). - Locales wouldn't help here, because "Decode_Language()" must work with any locale setting. Moreover, setting a language in Date::Calc would also require to set the proper corresponding locale in the current environment, which may not be available on the current system. The new solution works independently of any locale and with ALL languages (in ISO-Latin-1). + Added a patch which should ensure compatibility with VMS (this should resolve the problem of too long identifiers). + Added a missing "#include " statement in DateCalc.c (apparently only relevant to very few platforms). + Now automatically detects Perl's "PL_na" macro or switches to its older incarnation (in Calc.xs). Same goes for the "GIMME_V" macro. + Changed the function "Add_Delta_YMD()" to have a more intuitive, consistent and reversible behaviour. This might break existing code, though. (To get the old behaviour, use the new function "Add_Delta_YM()" plus "Add_Delta_Days()" thereafter instead.) + Changed the corresponding test script (t/f029.t) accordingly. + Added an optional boolean parameter "orthodox" to "Calendar()" for calendars starting with Sunday instead of Monday. + Changed the behaviour of the "Decode_Date_*()" set of functions: if the current year is available on the system, then a "moving window" strategy is applied to year numbers < 100; otherwise it defaults to the previous behaviour (see version 4.3 below). + Also changed the test scripts t/f016.t, t/f027.t and t/f028.t accordingly. + Changed the "Week_of_Year()" function: In scalar context, it now returns just the week number. BEWARE, this is a DANGEROUS feature - see the manual page for why this is so! + Fixed the misspelled word "whether" in the documentation. Module "Date::Calc::Object": + Added the module Date::Calc::Object, an object-oriented add-on to Date::Calc with overloaded operators. Modules "Date::Calendar[::(Year|Profiles)]": + Added the modules Date::Calendar, Date::Calendar::Year and Date::Calendar::Profiles, for calculations which need to take holidays into account (and for generating calendars). Module "Carp::Clan": + Added the module Carp::Clan (used by all new Date::* modules). All modules: + Now test scripts for Date::Calc and Carp::Clan ("functions") are in files ./t/f*.t, whereas test scripts of other, object-oriented modules ("methods") are in files ./t/m*.t. + Added new test scripts for all new modules. Version 4.3 08.01.2000 + Changed the behaviour of the "Decode_Date_*()" set of functions: Year numbers below 100 are now mapped to 1970 - 2069 (yy < 70 ? 20yy : 19yy). + Also changed the test scripts "t/f016.t", "t/f027.t" and "t/f028.t" accordingly. + Added Italian (i.e., the number of supported languages is now 7). + Added "English_Ordinal()". + Changed "Date_to_Text_Long()": The format now depends on the chosen language (set up your favourite format(s) in "DateCalc.c"!). + Changed test script "t/f012.t" accordingly. + Added a few new "recipes" in the "RECIPES" section of the manual page. Version 4.2 07.09.1998 + Added two casts to (char *) in the call of strncpy in Calc.xs line 857 to silence the two corresponding warnings. + Introduced an additional header "Preface" in the POD documentation to avoid clobbering of the information displayed by CPAN.pm et al. + Added the new attributes to "Makefile.PL" for ActiveState's port of Perl 5.005 to the Win32 platform. Version 4.1 08.06.1998 + Fixed the bug in "Add_Delta_YMD()" involving month offsets with days at the end of the month, which caused this function to return invalid dates. Version 4.0 12.05.1998 + Complete rewrite of the XS file. + Extensive rewrite of the C library at the core. + Changed the naming conventions for function names from all lower case to mixed upper- and lower case. + Added systematic exception handling. + Renamed the package from "Date::DateCalc" to simply "Date::Calc". + Renamed the corresponding files as well as the files of the C core. + Added a new Perl function "Week_of_Year()" (replacing "week_number()"). + Changed the Perl function "Week_Number()" to call the C function "Week_Number()". + Added new functions "System_Clock()", "Today()", "Now()" and "Today_and_Now()". + Added "check_business_date()", "Standard_to_Business()" and "Business_to_Standard()". + Ported the functions from "Date::DateCalcLib" from Perl to C. + Dropped the module "Date::DateCalcLib". + Added multi-language support. + Enhanced support for Windows NT/95. + Complete rewrite of the demo programs. + Complete rewrite of the documentation. + Added many new tools (like "upgrade_DC40.pl" and "iso2pc.c"). Version 3.2 15.06.1997 + Added the function "week_of_year()" in the C core because the C function "week_number()" returns the last week of the previous year or the first week of the next year in a rather hidden way. + The Perl function "week_number()" was not affected by this change. Version 3.1 12.06.1997 + Added a new function "calendar()" to the "Date::CalcLib" module. + Added a demo program in C named "cal.c_" (imitates the UNIX "cal" command) to demonstrate the use of the C core as a stand-alone library. Version 3.0 16.02.1997 + Added the "Date::DateCalcLib" module as a library of useful functions that were contained in the various demo files in previous versions. + Modified the demo programs to use this library instead. + Changed the conventions for unsuccessful returns: Now an empty list is returned instead of zeros in all list elements. This makes it possible to assign the returned list and to check for success in the same statement. Version 2.3 22.11.1996 + Fixed a problem with unbalanced "malloc" and "free" calls that only became apparent in Perl version 5.003: Calling "malloc" in the C core of my module and "free" in the XS file produced a "bad free() ignored" warning. + Added a function to call "free" in the C core instead. Version 2.2 26.05.1996 + Bugfix concerning arrays as parameters: Enabling prototypes in the XS file caused ($year,$mm,$dd) = first_in_week(week_number($year,$mm,$dd)); to break in the previous version, because "week_number()" passes an array to "first_in_week()". + Therefore, disabled prototypes. Version 2.1 26.05.1996 + Bugfix: Changed if ((*ss <= 60) and (*mm <= 60) and (*hh <= 24) and to if ((*ss < 60) and (*mm < 60) and (*hh < 24) and + Applied minor adjustments in orthography and style. + Made the necessary adaptations to conform with the new Perl 5.002 module standards (mainly concerning $VERSION and prototypes). + The man page is no separate file anymore, it is now included in the file "DateCalc.pm" in POD format, where it will automatically be found and installed in your "man" directory by "make install". Version 2.0 25.05.1996 + Added functions "date_time_difference()" and "calc_new_date_time()" for date/time calculations (plus some other new functions). + The german man page was dropped because it became too costly (i.e., time consuming) to maintain two man pages. + Dropped the functions "day_short_tab()" and "month_short_tab()", because they can be derived from the corresponding full text variants. + Renamed the functions "encode()", "decode()", "valid_date()" and "date_string()" to "compress()", "uncompress()", "check_compressed()" and "compressed_to_short()", respectively, for more consistency. + Modified the function "day_of_week()" to return 1..7 instead of 0..6 (in order to make the functions "decode_day()" and "decode_month()" work the same way). + Changed the function and table "day_name_tab()" accordingly. + Exported the functions "decode_day()" and "decode_month()", which were purely for internal use in previous versions. + Added a utility named "parse_date.pl" to parse the output of "/bin/date". Version 1.6 20.04.1996 + Tested with Perl 5.002 for compatibility (successfully). + Added another demo program which shows how to calculate, for instance, the 2nd Thursday of a given month and year. This version was never published. Version 1.5 14.03.1996 + Added a prominent notice that you need an ANSI C compiler in order to successfully install this package, because of too many problem reports of this kind from users. + Added a second demo program for decoding dates in U.S. american format. Version 1.4 11.02.1996 + Bugfix: The function newSVnv(double) was previously used in the XS file to create a new SV with an integer value passed to it. Fixed this to use newSViv(IV) instead. Version 1.3 10.12.1995 + The C library "lib_date.c" is compiled separately now, it is no longer "#include"d in the XS file. + Added the function "days_in_month()". Version 1.2b 27.11.1995 + Fixed EXTEND(SP,num) back into EXTEND(sp,num). + Marginal refinements of the documentation. + The fix for type name clashes of previous version apparently succeeded. Version 1.2a 21.11.1995 + Another attempt at fixing the problem of type name clashes. + Erroneously "fixed" EXTEND(sp,num) into EXTEND(SP,num). Version 1.1 18.11.1995 + Added test scripts for "make test". + Attempt at fixing the problem of type name clashes (changed "uint", "ulong" etc. to "unint", "unlong" etc.). Version 1.01 16.11.1995 + Made the necessary changes so as to comply with programming standards required for Perl modules. Version 1.0 14.11.1995 First version under UNIX (with Perl module) + Released as an article in the newsgroups comp.lang.perl.misc and de.comp.lang.perl. Version 0.9 01.11.1993 First version of C library under MS-DOS + I wrote this library in my spare time because the company I was working for at that time could have needed it: Instead of storing some values for the last 60 days in an array and the dates of the corresponding days in another array, my library would have permitted to economize the second array, calculating the corresponding date from the index of the first array and the current date. ---------------------------------------------------------------------------- Date-Calc-6.3/t/000755 100660 100660 00000000000 11272757315 012426 5ustar00sbsb000000 000000 Date-Calc-6.3/README.txt000644 100660 100660 00000003663 11272757315 013671 0ustar00sbsb000000 000000 ==================================== Package "Date::Calc" Version 6.3 ==================================== Abstract: --------- This package provides all sorts of date calculations based on the Gregorian calendar (the one used in all western countries today). The package is designed as an efficient (and fast) toolbox, not a bulky ready-made application. It provides extensive documentation and examples of use, multi-language support and special functions for business needs. Moreover, it optionally provides an object-oriented interface with overloaded operators for greater convenience, and calendar objects which support profiles of legal holidays and observances for calculations which need to take those into account. What's new in version 6.3: -------------------------- + Changed "Mktime()" to use "POSIX::mktime()" + Fixed the bug that "Date::Calc::PP" was never tested when "Date::Calc::XS" is installed Copyright & License: -------------------- This package with all its parts is Copyright (c) 1995 - 2009 by Steffen Beyer. All rights reserved. This package is free software; you can use, modify and redistribute it under the same terms as Perl itself, i.e., at your option, under the terms either of the "Artistic License" or the "GNU General Public License". The C library at the core of the module "Date::Calc::XS" can, at your discretion, also be used, modified and redistributed under the terms of the "GNU Library General Public License". Please refer to the files "Artistic.txt", "GNU_GPL.txt" and "GNU_LGPL.txt" in the "license" subdirectory of this distribution for any details! Installation: ------------- perl Makefile.PL make make test make install UNINST=1 Under Windows, depending on your environment, use "nmake" or "dmake" instead of "make". Contact Author: --------------- Steffen Beyer http://www.engelschall.com/u/sb/download/ Date-Calc-6.3/license/000755 100660 100660 00000000000 11272757315 013605 5ustar00sbsb000000 000000 Date-Calc-6.3/license/GNU_LGPL.txt000644 100660 100660 00000061271 11272757315 015624 0ustar00sbsb000000 000000 GNU LIBRARY GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the library GPL. It is numbered 2 because it goes with version 2 of the ordinary GPL.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Library General Public License, applies to some specially designated Free Software Foundation software, and to any other libraries whose authors decide to use it. You can use it for your libraries, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library, or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link a program with the library, you must provide complete object files to the recipients so that they can relink them with the library, after making changes to the library and recompiling it. And you must show them these terms so they know their rights. Our method of protecting your rights has two steps: (1) copyright the library, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the library. Also, for each distributor's protection, we want to make certain that everyone understands that there is no warranty for this free library. If the library is modified by someone else and passed on, we want its recipients to know that what they have is not the original version, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that companies distributing free software will individually obtain patent licenses, thus in effect transforming the program into proprietary software. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License, which was designed for utility programs. This license, the GNU Library General Public License, applies to certain designated libraries. This license is quite different from the ordinary one; be sure to read it in full, and don't assume that anything in it is the same as in the ordinary license. The reason we have a separate public license for some libraries is that they blur the distinction we usually make between modifying or adding to a program and simply using it. Linking a program with a library, without changing the library, is in some sense simply using the library, and is analogous to running a utility program or application program. However, in a textual and legal sense, the linked executable is a combined work, a derivative of the original library, and the ordinary General Public License treats it as such. Because of this blurred distinction, using the ordinary General Public License for libraries did not effectively promote software sharing, because most developers did not use the libraries. We concluded that weaker conditions might promote sharing better. However, unrestricted linking of non-free programs would deprive the users of those programs of all benefit from the free status of the libraries themselves. This Library General Public License is intended to permit developers of non-free programs to use free libraries, while preserving your freedom as a user of such programs to change the free libraries that are incorporated in them. (We have not seen how to achieve this as regards changes in header files, but we have achieved it as regards changes in the actual functions of the Library.) The hope is that this will lead to faster development of free libraries. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, while the latter only works together with the library. Note that it is possible for a library to be covered by the ordinary General Public License rather than by this special one. GNU LIBRARY GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Library General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also compile or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. c) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. d) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Library General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! Date-Calc-6.3/license/GNU_GPL.txt000644 100660 100660 00000043101 11272757315 015500 0ustar00sbsb000000 000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. Date-Calc-6.3/license/Artistic.txt000644 100660 100660 00000013737 11272757315 016143 0ustar00sbsb000000 000000 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Date-Calc-6.3/t/f010.t000644 100660 100660 00000003241 11272757315 013261 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Add_Delta_Days ); # ====================================================================== # ($year,$mm,$dd) = Add_Delta_Days($year,$mm,$dd,$offset); # ====================================================================== print "1..9\n"; $n = 1; if ((($year,$mm,$dd) = Add_Delta_Days(1964,1,3,11642)) && ($year==1995)&&($mm==11)&&($dd==18)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_Days(1995,11,18,-11642)) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_Days(1995,2,28,0)) && ($year==1995)&&($mm==2)&&($dd==28)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_Days(1995,2,28,-1)) && ($year==1995)&&($mm==2)&&($dd==27)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_Days(1995,2,28,1)) && ($year==1995)&&($mm==3)&&($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_Days(1995,2,29,-1); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_Days(1,1,1,0)) && ($year==1)&&($mm==1)&&($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_Days(1,1,1,-1); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_Days(0,1,1,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f031.t000644 100660 100660 00000040444 11272757315 013272 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Date_to_Days Easter_Sunday ); # ====================================================================== # ($year,$mm,$dd) = Easter_Sunday($year); # ====================================================================== print "1..719\n"; $date[1583] = 577913; $date[1584] = 578270; $date[1585] = 578655; $date[1586] = 579005; $date[1587] = 579362; $date[1588] = 579747; $date[1589] = 580097; $date[1590] = 580482; $date[1591] = 580839; $date[1592] = 581189; $date[1593] = 581574; $date[1594] = 581931; $date[1595] = 582281; $date[1596] = 582666; $date[1597] = 583023; $date[1598] = 583373; $date[1599] = 583758; $date[1600] = 584115; $date[1601] = 584500; $date[1602] = 584850; $date[1603] = 585207; $date[1604] = 585592; $date[1605] = 585949; $date[1606] = 586299; $date[1607] = 586684; $date[1608] = 587041; $date[1609] = 587419; $date[1610] = 587776; $date[1611] = 588133; $date[1612] = 588518; $date[1613] = 588868; $date[1614] = 589225; $date[1615] = 589610; $date[1616] = 589960; $date[1617] = 590317; $date[1618] = 590702; $date[1619] = 591052; $date[1620] = 591437; $date[1621] = 591794; $date[1622] = 592144; $date[1623] = 592529; $date[1624] = 592886; $date[1625] = 593243; $date[1626] = 593621; $date[1627] = 593978; $date[1628] = 594363; $date[1629] = 594720; $date[1630] = 595070; $date[1631] = 595455; $date[1632] = 595812; $date[1633] = 596162; $date[1634] = 596547; $date[1635] = 596904; $date[1636] = 597254; $date[1637] = 597639; $date[1638] = 597996; $date[1639] = 598381; $date[1640] = 598731; $date[1641] = 599088; $date[1642] = 599473; $date[1643] = 599823; $date[1644] = 600180; $date[1645] = 600565; $date[1646] = 600915; $date[1647] = 601300; $date[1648] = 601657; $date[1649] = 602014; $date[1650] = 602392; $date[1651] = 602749; $date[1652] = 603106; $date[1653] = 603484; $date[1654] = 603841; $date[1655] = 604198; $date[1656] = 604583; $date[1657] = 604933; $date[1658] = 605318; $date[1659] = 605675; $date[1660] = 606025; $date[1661] = 606410; $date[1662] = 606767; $date[1663] = 607117; $date[1664] = 607502; $date[1665] = 607859; $date[1666] = 608244; $date[1667] = 608594; $date[1668] = 608951; $date[1669] = 609336; $date[1670] = 609686; $date[1671] = 610043; $date[1672] = 610428; $date[1673] = 610778; $date[1674] = 611135; $date[1675] = 611520; $date[1676] = 611877; $date[1677] = 612255; $date[1678] = 612612; $date[1679] = 612969; $date[1680] = 613354; $date[1681] = 613704; $date[1682] = 614061; $date[1683] = 614446; $date[1684] = 614796; $date[1685] = 615181; $date[1686] = 615538; $date[1687] = 615888; $date[1688] = 616273; $date[1689] = 616630; $date[1690] = 616980; $date[1691] = 617365; $date[1692] = 617722; $date[1693] = 618072; $date[1694] = 618457; $date[1695] = 618814; $date[1696] = 619199; $date[1697] = 619549; $date[1698] = 619906; $date[1699] = 620291; $date[1700] = 620648; $date[1701] = 620998; $date[1702] = 621383; $date[1703] = 621740; $date[1704] = 622090; $date[1705] = 622475; $date[1706] = 622832; $date[1707] = 623217; $date[1708] = 623567; $date[1709] = 623924; $date[1710] = 624309; $date[1711] = 624659; $date[1712] = 625016; $date[1713] = 625401; $date[1714] = 625751; $date[1715] = 626136; $date[1716] = 626493; $date[1717] = 626843; $date[1718] = 627228; $date[1719] = 627585; $date[1720] = 627942; $date[1721] = 628320; $date[1722] = 628677; $date[1723] = 629034; $date[1724] = 629419; $date[1725] = 629769; $date[1726] = 630154; $date[1727] = 630511; $date[1728] = 630861; $date[1729] = 631246; $date[1730] = 631603; $date[1731] = 631953; $date[1732] = 632338; $date[1733] = 632695; $date[1734] = 633080; $date[1735] = 633430; $date[1736] = 633787; $date[1737] = 634172; $date[1738] = 634522; $date[1739] = 634879; $date[1740] = 635264; $date[1741] = 635614; $date[1742] = 635971; $date[1743] = 636356; $date[1744] = 636713; $date[1745] = 637091; $date[1746] = 637448; $date[1747] = 637805; $date[1748] = 638183; $date[1749] = 638540; $date[1750] = 638897; $date[1751] = 639275; $date[1752] = 639632; $date[1753] = 640017; $date[1754] = 640374; $date[1755] = 640724; $date[1756] = 641109; $date[1757] = 641466; $date[1758] = 641816; $date[1759] = 642201; $date[1760] = 642558; $date[1761] = 642908; $date[1762] = 643293; $date[1763] = 643650; $date[1764] = 644035; $date[1765] = 644385; $date[1766] = 644742; $date[1767] = 645127; $date[1768] = 645477; $date[1769] = 645834; $date[1770] = 646219; $date[1771] = 646569; $date[1772] = 646954; $date[1773] = 647311; $date[1774] = 647668; $date[1775] = 648046; $date[1776] = 648403; $date[1777] = 648760; $date[1778] = 649145; $date[1779] = 649495; $date[1780] = 649852; $date[1781] = 650237; $date[1782] = 650587; $date[1783] = 650972; $date[1784] = 651329; $date[1785] = 651679; $date[1786] = 652064; $date[1787] = 652421; $date[1788] = 652771; $date[1789] = 653156; $date[1790] = 653513; $date[1791] = 653898; $date[1792] = 654248; $date[1793] = 654605; $date[1794] = 654990; $date[1795] = 655340; $date[1796] = 655697; $date[1797] = 656082; $date[1798] = 656439; $date[1799] = 656789; $date[1800] = 657174; $date[1801] = 657531; $date[1802] = 657909; $date[1803] = 658266; $date[1804] = 658623; $date[1805] = 659001; $date[1806] = 659358; $date[1807] = 659715; $date[1808] = 660100; $date[1809] = 660450; $date[1810] = 660835; $date[1811] = 661192; $date[1812] = 661542; $date[1813] = 661927; $date[1814] = 662284; $date[1815] = 662634; $date[1816] = 663019; $date[1817] = 663376; $date[1818] = 663726; $date[1819] = 664111; $date[1820] = 664468; $date[1821] = 664853; $date[1822] = 665203; $date[1823] = 665560; $date[1824] = 665945; $date[1825] = 666295; $date[1826] = 666652; $date[1827] = 667037; $date[1828] = 667394; $date[1829] = 667772; $date[1830] = 668129; $date[1831] = 668486; $date[1832] = 668871; $date[1833] = 669221; $date[1834] = 669578; $date[1835] = 669963; $date[1836] = 670313; $date[1837] = 670670; $date[1838] = 671055; $date[1839] = 671405; $date[1840] = 671790; $date[1841] = 672147; $date[1842] = 672497; $date[1843] = 672882; $date[1844] = 673239; $date[1845] = 673589; $date[1846] = 673974; $date[1847] = 674331; $date[1848] = 674716; $date[1849] = 675066; $date[1850] = 675423; $date[1851] = 675808; $date[1852] = 676165; $date[1853] = 676515; $date[1854] = 676900; $date[1855] = 677257; $date[1856] = 677607; $date[1857] = 677992; $date[1858] = 678349; $date[1859] = 678734; $date[1860] = 679084; $date[1861] = 679441; $date[1862] = 679826; $date[1863] = 680176; $date[1864] = 680533; $date[1865] = 680918; $date[1866] = 681268; $date[1867] = 681653; $date[1868] = 682010; $date[1869] = 682360; $date[1870] = 682745; $date[1871] = 683102; $date[1872] = 683459; $date[1873] = 683837; $date[1874] = 684194; $date[1875] = 684551; $date[1876] = 684936; $date[1877] = 685286; $date[1878] = 685671; $date[1879] = 686028; $date[1880] = 686378; $date[1881] = 686763; $date[1882] = 687120; $date[1883] = 687470; $date[1884] = 687855; $date[1885] = 688212; $date[1886] = 688597; $date[1887] = 688947; $date[1888] = 689304; $date[1889] = 689689; $date[1890] = 690039; $date[1891] = 690396; $date[1892] = 690781; $date[1893] = 691131; $date[1894] = 691488; $date[1895] = 691873; $date[1896] = 692230; $date[1897] = 692608; $date[1898] = 692965; $date[1899] = 693322; $date[1900] = 693700; $date[1901] = 694057; $date[1902] = 694414; $date[1903] = 694792; $date[1904] = 695149; $date[1905] = 695534; $date[1906] = 695891; $date[1907] = 696241; $date[1908] = 696626; $date[1909] = 696983; $date[1910] = 697333; $date[1911] = 697718; $date[1912] = 698075; $date[1913] = 698425; $date[1914] = 698810; $date[1915] = 699167; $date[1916] = 699552; $date[1917] = 699902; $date[1918] = 700259; $date[1919] = 700644; $date[1920] = 700994; $date[1921] = 701351; $date[1922] = 701736; $date[1923] = 702086; $date[1924] = 702471; $date[1925] = 702828; $date[1926] = 703185; $date[1927] = 703563; $date[1928] = 703920; $date[1929] = 704277; $date[1930] = 704662; $date[1931] = 705012; $date[1932] = 705369; $date[1933] = 705754; $date[1934] = 706104; $date[1935] = 706489; $date[1936] = 706846; $date[1937] = 707196; $date[1938] = 707581; $date[1939] = 707938; $date[1940] = 708288; $date[1941] = 708673; $date[1942] = 709030; $date[1943] = 709415; $date[1944] = 709765; $date[1945] = 710122; $date[1946] = 710507; $date[1947] = 710857; $date[1948] = 711214; $date[1949] = 711599; $date[1950] = 711956; $date[1951] = 712306; $date[1952] = 712691; $date[1953] = 713048; $date[1954] = 713426; $date[1955] = 713783; $date[1956] = 714140; $date[1957] = 714525; $date[1958] = 714875; $date[1959] = 715232; $date[1960] = 715617; $date[1961] = 715967; $date[1962] = 716352; $date[1963] = 716709; $date[1964] = 717059; $date[1965] = 717444; $date[1966] = 717801; $date[1967] = 718151; $date[1968] = 718536; $date[1969] = 718893; $date[1970] = 719250; $date[1971] = 719628; $date[1972] = 719985; $date[1973] = 720370; $date[1974] = 720727; $date[1975] = 721077; $date[1976] = 721462; $date[1977] = 721819; $date[1978] = 722169; $date[1979] = 722554; $date[1980] = 722911; $date[1981] = 723289; $date[1982] = 723646; $date[1983] = 724003; $date[1984] = 724388; $date[1985] = 724738; $date[1986] = 725095; $date[1987] = 725480; $date[1988] = 725830; $date[1989] = 726187; $date[1990] = 726572; $date[1991] = 726922; $date[1992] = 727307; $date[1993] = 727664; $date[1994] = 728021; $date[1995] = 728399; $date[1996] = 728756; $date[1997] = 729113; $date[1998] = 729491; $date[1999] = 729848; $date[2000] = 730233; $date[2001] = 730590; $date[2002] = 730940; $date[2003] = 731325; $date[2004] = 731682; $date[2005] = 732032; $date[2006] = 732417; $date[2007] = 732774; $date[2008] = 733124; $date[2009] = 733509; $date[2010] = 733866; $date[2011] = 734251; $date[2012] = 734601; $date[2013] = 734958; $date[2014] = 735343; $date[2015] = 735693; $date[2016] = 736050; $date[2017] = 736435; $date[2018] = 736785; $date[2019] = 737170; $date[2020] = 737527; $date[2021] = 737884; $date[2022] = 738262; $date[2023] = 738619; $date[2024] = 738976; $date[2025] = 739361; $date[2026] = 739711; $date[2027] = 740068; $date[2028] = 740453; $date[2029] = 740803; $date[2030] = 741188; $date[2031] = 741545; $date[2032] = 741895; $date[2033] = 742280; $date[2034] = 742637; $date[2035] = 742987; $date[2036] = 743372; $date[2037] = 743729; $date[2038] = 744114; $date[2039] = 744464; $date[2040] = 744821; $date[2041] = 745206; $date[2042] = 745556; $date[2043] = 745913; $date[2044] = 746298; $date[2045] = 746655; $date[2046] = 747005; $date[2047] = 747390; $date[2048] = 747747; $date[2049] = 748125; $date[2050] = 748482; $date[2051] = 748839; $date[2052] = 749224; $date[2053] = 749574; $date[2054] = 749931; $date[2055] = 750316; $date[2056] = 750666; $date[2057] = 751051; $date[2058] = 751408; $date[2059] = 751758; $date[2060] = 752143; $date[2061] = 752500; $date[2062] = 752850; $date[2063] = 753235; $date[2064] = 753592; $date[2065] = 753949; $date[2066] = 754327; $date[2067] = 754684; $date[2068] = 755069; $date[2069] = 755426; $date[2070] = 755776; $date[2071] = 756161; $date[2072] = 756518; $date[2073] = 756868; $date[2074] = 757253; $date[2075] = 757610; $date[2076] = 757988; $date[2077] = 758345; $date[2078] = 758702; $date[2079] = 759087; $date[2080] = 759437; $date[2081] = 759794; $date[2082] = 760179; $date[2083] = 760529; $date[2084] = 760886; $date[2085] = 761271; $date[2086] = 761621; $date[2087] = 762006; $date[2088] = 762363; $date[2089] = 762720; $date[2090] = 763098; $date[2091] = 763455; $date[2092] = 763812; $date[2093] = 764190; $date[2094] = 764547; $date[2095] = 764932; $date[2096] = 765289; $date[2097] = 765639; $date[2098] = 766024; $date[2099] = 766381; $date[2100] = 766731; $date[2101] = 767116; $date[2102] = 767473; $date[2103] = 767823; $date[2104] = 768208; $date[2105] = 768565; $date[2106] = 768943; $date[2107] = 769300; $date[2108] = 769657; $date[2109] = 770042; $date[2110] = 770392; $date[2111] = 770749; $date[2112] = 771134; $date[2113] = 771484; $date[2114] = 771869; $date[2115] = 772226; $date[2116] = 772576; $date[2117] = 772961; $date[2118] = 773318; $date[2119] = 773668; $date[2120] = 774053; $date[2121] = 774410; $date[2122] = 774767; $date[2123] = 775145; $date[2124] = 775502; $date[2125] = 775887; $date[2126] = 776244; $date[2127] = 776594; $date[2128] = 776979; $date[2129] = 777336; $date[2130] = 777686; $date[2131] = 778071; $date[2132] = 778428; $date[2133] = 778806; $date[2134] = 779163; $date[2135] = 779520; $date[2136] = 779905; $date[2137] = 780255; $date[2138] = 780612; $date[2139] = 780997; $date[2140] = 781347; $date[2141] = 781704; $date[2142] = 782089; $date[2143] = 782439; $date[2144] = 782824; $date[2145] = 783181; $date[2146] = 783538; $date[2147] = 783916; $date[2148] = 784273; $date[2149] = 784630; $date[2150] = 785008; $date[2151] = 785365; $date[2152] = 785750; $date[2153] = 786107; $date[2154] = 786457; $date[2155] = 786842; $date[2156] = 787199; $date[2157] = 787549; $date[2158] = 787934; $date[2159] = 788291; $date[2160] = 788641; $date[2161] = 789026; $date[2162] = 789383; $date[2163] = 789768; $date[2164] = 790118; $date[2165] = 790475; $date[2166] = 790860; $date[2167] = 791210; $date[2168] = 791567; $date[2169] = 791952; $date[2170] = 792302; $date[2171] = 792687; $date[2172] = 793044; $date[2173] = 793401; $date[2174] = 793779; $date[2175] = 794136; $date[2176] = 794493; $date[2177] = 794878; $date[2178] = 795228; $date[2179] = 795585; $date[2180] = 795970; $date[2181] = 796320; $date[2182] = 796705; $date[2183] = 797062; $date[2184] = 797412; $date[2185] = 797797; $date[2186] = 798154; $date[2187] = 798504; $date[2188] = 798889; $date[2189] = 799246; $date[2190] = 799631; $date[2191] = 799981; $date[2192] = 800338; $date[2193] = 800723; $date[2194] = 801073; $date[2195] = 801430; $date[2196] = 801815; $date[2197] = 802172; $date[2198] = 802522; $date[2199] = 802907; $date[2200] = 803264; $date[2201] = 803642; $date[2202] = 803999; $date[2203] = 804356; $date[2204] = 804741; $date[2205] = 805091; $date[2206] = 805448; $date[2207] = 805833; $date[2208] = 806183; $date[2209] = 806540; $date[2210] = 806925; $date[2211] = 807275; $date[2212] = 807660; $date[2213] = 808017; $date[2214] = 808367; $date[2215] = 808752; $date[2216] = 809109; $date[2217] = 809466; $date[2218] = 809844; $date[2219] = 810201; $date[2220] = 810586; $date[2221] = 810943; $date[2222] = 811293; $date[2223] = 811678; $date[2224] = 812035; $date[2225] = 812385; $date[2226] = 812770; $date[2227] = 813127; $date[2228] = 813477; $date[2229] = 813862; $date[2230] = 814219; $date[2231] = 814604; $date[2232] = 814954; $date[2233] = 815311; $date[2234] = 815696; $date[2235] = 816046; $date[2236] = 816403; $date[2237] = 816788; $date[2238] = 817138; $date[2239] = 817523; $date[2240] = 817880; $date[2241] = 818237; $date[2242] = 818615; $date[2243] = 818972; $date[2244] = 819329; $date[2245] = 819707; $date[2246] = 820064; $date[2247] = 820421; $date[2248] = 820806; $date[2249] = 821156; $date[2250] = 821541; $date[2251] = 821898; $date[2252] = 822248; $date[2253] = 822633; $date[2254] = 822990; $date[2255] = 823340; $date[2256] = 823725; $date[2257] = 824082; $date[2258] = 824467; $date[2259] = 824817; $date[2260] = 825174; $date[2261] = 825559; $date[2262] = 825909; $date[2263] = 826266; $date[2264] = 826651; $date[2265] = 827001; $date[2266] = 827358; $date[2267] = 827743; $date[2268] = 828100; $date[2269] = 828478; $date[2270] = 828835; $date[2271] = 829192; $date[2272] = 829577; $date[2273] = 829927; $date[2274] = 830284; $date[2275] = 830669; $date[2276] = 831019; $date[2277] = 831404; $date[2278] = 831761; $date[2279] = 832111; $date[2280] = 832496; $date[2281] = 832853; $date[2282] = 833203; $date[2283] = 833588; $date[2284] = 833945; $date[2285] = 834295; $date[2286] = 834680; $date[2287] = 835037; $date[2288] = 835422; $date[2289] = 835772; $date[2290] = 836129; $date[2291] = 836514; $date[2292] = 836871; $date[2293] = 837221; $date[2294] = 837606; $date[2295] = 837963; $date[2296] = 838341; $date[2297] = 838698; $date[2298] = 839055; $date[2299] = 839433; $n = 1; eval { ($year,$mm,$dd) = Easter_Sunday(1582); }; if ($@ =~ /year out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Easter_Sunday(2300); }; if ($@ =~ /year out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; for ( $year = 1583; $year < 2300; $year++ ) { if ((($yy,$mm,$dd) = Easter_Sunday($year)) && (Date_to_Days($yy,$mm,$dd) == $date[$year])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } __END__ Date-Calc-6.3/t/m006.t000644 100660 100660 00000006142 11272757315 013300 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); # ====================================================================== # $date = Date::Calc->time2date([TIME]); # $time = $date->date2time(); # ====================================================================== # $date = Date::Calc->gmtime([TIME]); # $date = Date::Calc->localtime([TIME]); # $time = $date->mktime(); # ====================================================================== # Unix epoch is Thu 1-Jan-1970 00:00:00 (GMT) # Classic MacOS epoch is Fri 1-Jan-1904 00:00:00 (local time) # # Unix time overflow is Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) # MacOS time overflow is Mon 6-Feb-2040 06:28:15 (time=0xFFFFFFFF) if ($^O eq 'MacOS') { $max_time = 0xFFFFFFFF; $epoch_vec = [1904,1,1,0,0,0]; $epoch_str = 'Friday, January 1st 1904 00:00:00'; $max_vec = [2040,2,6,6,28,15]; $max_str = 'Monday, February 6th 2040 06:28:15'; $match_vec = [1935,6,10,15,42,30]; $match_str = 'Monday, June 10th 1935 15:42:30'; } else { $max_time = 0x7FFFFFFF; $epoch_vec = [1970,1,1,0,0,0]; $epoch_str = 'Thursday, January 1st 1970 00:00:00'; $max_vec = [2038,1,19,3,14,7]; $max_str = 'Tuesday, January 19th 2038 03:14:07'; $match_vec = [2001,6,10,15,42,30]; $match_str = 'Sunday, June 10th 2001 15:42:30'; } print "1..18\n"; $n = 1; $date = Date::Calc->time2date(0); if ($date eq $epoch_vec) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date->date_format(3); if ("$date" eq $epoch_str) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->date2time() == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date->time2date($max_time); if ($date eq $max_vec) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$date" eq $max_str) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->date2time() == $max_time) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $time = 992187750; $date->time2date($time); if ($date eq $match_vec) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$date" eq $match_str) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->date2time() == $time) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date->gmtime(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date gt $match_vec) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date->time2date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date gt $match_vec) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date->localtime(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->is_valid()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date gt $match_vec) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $time = $date->mktime(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($time > 992187750) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f021.t000644 100660 100660 00000012206 11272757315 013264 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Decode_Month ); # ====================================================================== # $month_name = Decode_Month($month); # ====================================================================== print "1..58\n"; $n = 1; if (Decode_Month("j") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("ja") == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("jan") == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("January") == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("f") == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("fe") == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("feb") == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("February") == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("m") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("ma") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("mar") == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("March") == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("a") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("ap") == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("apr") == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("April") == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("m") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("ma") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("may") == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("May") == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("j") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("ju") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("jun") == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("June") == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("j") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("ju") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("jul") == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("July") == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("a") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("au") == 8) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("aug") == 8) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("August") == 8) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("s") == 9) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("se") == 9) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("sep") == 9) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("September") == 9) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("o") == 10) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("oc") == 10) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("oct") == 10) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("October") == 10) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("n") == 11) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("no") == 11) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("nov") == 11) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("November") == 11) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("d") == 12) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("de") == 12) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("dec") == 12) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("December") == 12) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Spring") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Summer") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Fall") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Winter") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("May",0) == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Mar",1) == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Mag",7) == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Giu",7) == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("Tam",11) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Month("dic",4) == 12) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f000.t000644 100660 100660 00000007315 11272757315 013266 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } # ====================================================================== # $version = $Carp::Clan::VERSION; # $version = $Date::Calc::VERSION; # $version = &Date::Calc::Version(); # $version = $Date::Calc::Object::VERSION; # $version = $Date::Calendar::Profiles::VERSION; # $version = $Date::Calendar::Year::VERSION; # $version = $Date::Calendar::VERSION; # ====================================================================== $Carp::Clan::VERSION = $Carp::Clan::VERSION = 0; $Date::Calc::XS_OK = $Date::Calc::XS_OK = 0; $Date::Calc::VERSION = $Date::Calc::VERSION = 0; $Date::Calc::PP::VERSION = $Date::Calc::PP::VERSION = 0; $Date::Calc::XS::VERSION = $Date::Calc::XS::VERSION = 0; $Date::Calc::Object::VERSION = $Date::Calc::Object::VERSION = 0; $Date::Calendar::Profiles::VERSION = $Date::Calendar::Profiles::VERSION = 0; $Date::Calendar::Year::VERSION = $Date::Calendar::Year::VERSION = 0; $Date::Calendar::VERSION = $Date::Calendar::VERSION = 0; $Bit::Vector::VERSION = $Bit::Vector::VERSION = 0; $tests = 12; eval { require Bit::Vector; }; unless ($@) { $tests += 6; } print "1..$tests\n"; $n = 1; eval { require Carp::Clan; Carp::Clan->import( qw(^Date::) ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($Carp::Clan::VERSION >= 5.3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { require Date::Calc; Date::Calc->import( qw(:all) ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($Date::Calc::VERSION eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (&Date::Calc::Version() eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless ($Date::Calc::XS_OK || 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($Date::Calc::XS_OK || 0) { if ($Date::Calc::XS::VERSION >= '6.2') {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (&Date::Calc::XS::Version() >= '6.2') {print "ok $n\n";} else {print "not ok $n\n";} $n++; } else { if ($Date::Calc::PP::VERSION eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (&Date::Calc::PP::Version() eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; } eval { require Date::Calc::Object; Date::Calc::Object->import( qw(:all) ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($Date::Calc::Object::VERSION eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { require Date::Calendar::Profiles; Date::Calendar::Profiles->import( qw( $Profiles ) ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($Date::Calendar::Profiles::VERSION eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; exit 0 if $n > $tests; if ($Bit::Vector::VERSION >= '7.1') {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (&Bit::Vector::Version() >= '7.1') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { require Date::Calendar::Year; Date::Calendar::Year->import( qw(:all) ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($Date::Calendar::Year::VERSION eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { require Date::Calendar; Date::Calendar::Year->import( qw() ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($Date::Calendar::VERSION eq '6.3') {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f001.t000644 100660 100660 00000001272 11272757315 013263 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( leap_year ); # ====================================================================== # $flag = leap_year($year); # ====================================================================== print "1..4\n"; $n = 1; if (leap_year(1900) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (leap_year(1964) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (leap_year(1998) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (leap_year(2000) == 1) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f020.t000644 100660 100660 00000007773 11272757315 013300 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Decode_Day_of_Week ); # ====================================================================== # $weekday = Decode_Day_of_Week($buffer); # ====================================================================== print "1..40\n"; $n = 1; if (Decode_Day_of_Week("m") == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("mo") == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("mon") == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Monday") == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("t") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("tu") == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("tue") == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Tuesday") == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("w") == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("we") == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("wed") == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Wednesday") == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("t") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("th") == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("thu") == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Thursday") == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("f") == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("fr") == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("fri") == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Friday") == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("s") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("sa") == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("sat") == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Saturday") == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("s") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("su") == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("sun") == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Sunday") == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("workday") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("funday") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("bad day") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("sunny day") == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("payday") == 0) # too bad! ;-) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("holyday") == 0) # sigh. ;-) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Sun",0) == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Sonntag",3) == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Dimanche",2) == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Dim",2) == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Jue",4) == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Decode_Day_of_Week("Qua",5) == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/m007.t000644 100660 100660 00000001634 11272757315 013302 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } eval { require Bit::Vector; }; if ($@) { print "1..0\n"; exit 0; } require Date::Calendar; require Date::Calendar::Profiles; Date::Calendar::Profiles->import('$Profiles'); # ====================================================================== # $cal = Date::Calendar->new($prof); # $year = $cal->year($year); # $year = Date::Calendar::Year->new($year,$prof); # (implicitly) # ====================================================================== print "1..", scalar(keys %{$Profiles}), "\n"; $n = 1; $year = 2000; foreach $key (keys %{$Profiles}) { eval { $cal = Date::Calendar->new( $Profiles->{$key} ); $year = $cal->year( $year ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } __END__ Date-Calc-6.3/t/f030.t000644 100660 100660 00000005207 11272757315 013267 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Parse_Date ); # ====================================================================== # ($year,$mm,$dd) = Parse_Date($date); # ====================================================================== print "1..15\n"; $n = 1; unless (($year,$mm,$dd) = Parse_Date("")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Sat Dec 2 00:10:10 1995")) && ($year==1995) && ($mm==12) && ($dd==2)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Tue Jan 04 16:31:59 1996")) && ($year==1996) && ($mm==1) && ($dd==4)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Sun Feb 16 00:01:13 GMT+0100 1997")) && ($year==1997) && ($mm==2) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Jane 1997 Feb 16 birthday")) && ($year==1997) && ($mm==2) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Jan 1997 Feb 16 birthday")) && ($year==1997) && ($mm==2) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Jan 1997 Feb 16 birthday",0)) && ($year==1997) && ($mm==2) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Jan 1997 Feb 16 birthday",())) && ($year==1997) && ($mm==2) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Jan 1997 Feb 16 birthday",)) && ($year==1997) && ($mm==2) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Jan 1997 May 16 birthday",1)) && ($year==1997) && ($mm==5) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Jan 1997 Mai 16 Geburtstag",3)) && ($year==1997) && ($mm==5) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Gen 1997 Mag 16 compleanno",7)) && ($year==1997) && ($mm==5) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Parse_Date("Ene 1997 Dic 16 cumpleańos",4)) && ($year==1997) && ($mm==12) && ($dd==16)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Parse_Date("Tue Jan 04 16:31:59 1896")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Parse_Date("Sun Feb 29 00:01:13 GMT+0100 1997")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f011.t000644 100660 100660 00000002331 11272757315 013261 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Date_to_Text ); # ====================================================================== # $datestr = Date_to_Text($year,$mm,$dd); # ====================================================================== print "1..8\n"; $n = 1; if (Date_to_Text(1964,1,3) eq "Fri 3-Jan-1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text(1995,11,18) eq "Sat 18-Nov-1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text(1964,1,3,0) eq "Fri 3-Jan-1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text(1995,11,18,0) eq "Sat 18-Nov-1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text(1964,1,3,1) eq "Fri 3-Jan-1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text(1995,11,18,1) eq "Sat 18-Nov-1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text(1964,1,3,11) eq "per 3-tam-1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text(1995,11,18,11) eq "lau 18-mar-1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f013.t000644 100660 100660 00000002647 11272757315 013275 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Week_of_Year ); # ====================================================================== # ($week,$year) = Week_of_Year($year,$mm,$dd); # ====================================================================== print "1..8\n"; $n = 1; if ((($week,$year) = Week_of_Year(1995,1,1)) && ($week==52)&&($year==1994)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($week,$year) = Week_of_Year(1995,11,18)) && ($week==46)&&($year==1995)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($week,$year) = Week_of_Year(1995,12,31)) && ($week==52)&&($year==1995)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($week,$year) = Week_of_Year(1964,1,3)) && ($week==1)&&($year==1964)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($week,$year) = Week_of_Year(1964,12,31)) && ($week==53)&&($year==1964)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($week,$year) = Week_of_Year(1965,1,1)) && ($week==53)&&($year==1964)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($week,$year) = Week_of_Year(0,1,1); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($week,$year) = Week_of_Year(1997,2,29); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f032.t000644 100660 100660 00000013462 11272757315 013273 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Calendar ); # ====================================================================== # $string = Calendar($year,$month[$orthodox[,$lang]]); # ====================================================================== print "1..24\n"; $test[1] = <<"VERBATIM"; January 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[2] = <<"VERBATIM"; February 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 VERBATIM $test[3] = <<"VERBATIM"; March 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[4] = <<"VERBATIM"; April 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[5] = <<"VERBATIM"; May 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[6] = <<"VERBATIM"; June 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[7] = <<"VERBATIM"; July 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[8] = <<"VERBATIM"; August 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[9] = <<"VERBATIM"; September 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[10] = <<"VERBATIM"; October 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[11] = <<"VERBATIM"; November 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[12] = <<"VERBATIM"; December 1996 Mon Tue Wed Thu Fri Sat Sun 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[13] = <<"VERBATIM"; January 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[14] = <<"VERBATIM"; February 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 VERBATIM $test[15] = <<"VERBATIM"; March 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[16] = <<"VERBATIM"; April 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[17] = <<"VERBATIM"; May 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[18] = <<"VERBATIM"; June 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[19] = <<"VERBATIM"; July 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[20] = <<"VERBATIM"; August 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[21] = <<"VERBATIM"; September 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[22] = <<"VERBATIM"; October 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $test[23] = <<"VERBATIM"; November 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 VERBATIM $test[24] = <<"VERBATIM"; December 1997 Sun Mon Tue Wed Thu Fri Sat 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 VERBATIM $n = 1; $ortho = 0; for ( $year = 1996; $year <= 1997; $year++, $ortho++ ) { for ( $month = 1; $month <= 12; $month++ ) { if (Calendar($year,$month,$ortho) eq $test[$n]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } } __END__ Date-Calc-6.3/t/f009.t000644 100660 100660 00000002550 11272757315 013273 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Day_of_Week ); # ====================================================================== # $weekday = Day_of_Week($year,$mm,$dd); # ====================================================================== print "1..11\n"; $n = 1; if (Day_of_Week(1964,1,3) == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,13) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,14) == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,15) == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,16) == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,17) == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,18) == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,19) == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,11,20) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week(1995,2,28) == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week(1995,2,29); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f028.t000644 100660 100660 00000016026 11272757315 013277 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Decode_Date_EU2 Language Decode_Language ); # ====================================================================== # ($year,$mm,$dd) = Decode_Date_EU2($date); # ====================================================================== print "1..46\n"; $n = 1; unless (($year,$mm,$dd) = Decode_Date_EU2("")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_EU2("__")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_EU2("_31_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_314_")) && ($year==2004) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_0314_")) && ($year==2004) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_00314_")) && ($year==2004) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3164_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_03164_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_003164_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_30164_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_030164_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_0030164_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_110364_")) && ($year==1964) && ($mm==3) && ($dd==11)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_0110364_")) && ($year==1964) && ($mm==3) && ($dd==11)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_00110364_")) && ($year==1964) && ($mm==3) && ($dd==11)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3011964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_03011964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_003011964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_11031964_")) && ($year==1964) && ($mm==3) && ($dd==11)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_011031964_")) && ($year==1964) && ($mm==3) && ($dd==11)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_0011031964_")) && ($year==1964) && ($mm==3) && ($dd==11)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3_1_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3_1_1964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3_jan_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3_Jan_64_",0)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3_jAN_64_",1)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3-JAN-64_",2)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3-Jan-1964_",3)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3-January-1964_",'')) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_000003-Jan-000064_",undef)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_000003-Jan-001964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3_ja_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_EU2("_3_j_64_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3ja64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_03ja64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_003ja64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_000003ja000064_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_3ja1964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_03ja1964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_003ja1964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_000003ja001964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_EU2("_33ja64_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_EU2("_33ja1964_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("x000003x000001x000064x")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("x000003_ja_000064x")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU2("_dia_tres_3_janeiro_1964_mil_novecentos_sessenta_e_seis_",Decode_Language("Portug"))) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/m005.t000644 100660 100660 00000011034 11272757315 013273 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); # ====================================================================== # $form = Date::Calc->date_format([FORMAT]); # $lang = Date::Calc->language([LANG]); # $form = $date->date_format([FORMAT]); # $lang = $date->language([LANG]); # $text = $date->string([FORMAT[,LANG]]); # ====================================================================== print "1..30\n"; $n = 1; Date::Calc->date_format(1); Date::Calc->language(2); $date = Date::Calc->new(2001,8,5); if ("$date" eq '05-aoű-2001') {print "ok $n\n";} else {print "not ok $n\n";} # 01 $n++; if (Language_to_Text(Language()) eq 'Français') {print "ok $n\n";} else {print "not ok $n\n";} # 02 $n++; $date->date_format(3); $date->language("Port"); if ("$date" eq 'Domingo, dia 5 de agosto de 2001') {print "ok $n\n";} else {print "not ok $n\n";} # 03 $n++; if (Language_to_Text(Language()) eq 'Français') {print "ok $n\n";} else {print "not ok $n\n";} # 04 $n++; Date::Calc->date_format(2); Date::Calc->language(11); { local($date->[0][2]) = undef; if ("$date" eq 'Dom 5-ago-2001') {print "ok $n\n";} else {print "not ok $n\n";} # 05 $n++; if (Language_to_Text(Language()) eq 'suomi') {print "ok $n\n";} else {print "not ok $n\n";} # 06 $n++; } if ("$date" eq 'Domingo, dia 5 de agosto de 2001') {print "ok $n\n";} else {print "not ok $n\n";} # 07 $n++; { local($date->[0][3]) = undef; if ("$date" eq 'sunnuntai, 5. elokuuta 2001') {print "ok $n\n";} else {print "not ok $n\n";} # 08 $n++; if (Language_to_Text(Language()) eq 'suomi') {print "ok $n\n";} else {print "not ok $n\n";} # 09 $n++; } if ("$date" eq 'Domingo, dia 5 de agosto de 2001') {print "ok $n\n";} else {print "not ok $n\n";} # 10 $n++; $text = ''; { if ($text eq '') {print "ok $n\n";} else {print "not ok $n\n";} # 11 $n++; local($date->[0][3]) = -1; eval { $text = "$date"; }; if ($@ =~ /\bDate::Calc::string\(\): no such language\b/) {print "ok $n\n";} else {print "not ok $n\n";} # 12 $n++; if ($text eq '') {print "ok $n\n";} else {print "not ok $n\n";} # 13 $n++; if (Language_to_Text(Language()) eq 'suomi') {print "ok $n\n";} else {print "not ok $n\n";} # 14 $n++; } $format = sub { Date_to_Text_Long($_[0]->date(),$_[2]); }; if ($date->string($format, 9) eq 'söndag, 5 augusti 2001') {print "ok $n\n";} else {print "not ok $n\n";} # 15 $n++; $lang = ''; $format = sub { $lang = Language_to_Text($_[2]); Date_to_Text_Long($_[0]->date(),$_[2]); }; if ($lang eq '') {print "ok $n\n";} else {print "not ok $n\n";} # 16 $n++; if ($date->string($format, 6) eq 'Zondag, 5 augustus 2001') {print "ok $n\n";} else {print "not ok $n\n";} # 17 $n++; if ($lang eq 'Nederlands') {print "ok $n\n";} else {print "not ok $n\n";} # 18 $n++; if (Language_to_Text(Language()) eq 'suomi') {print "ok $n\n";} else {print "not ok $n\n";} # 19 $n++; $format = sub { $lang = Language_to_Text($_[2]); join('~', $_[0]->datetime()); }; if ($lang eq 'Nederlands') {print "ok $n\n";} else {print "not ok $n\n";} # 20 $n++; if ($date->string($format, 9) eq '2001~8~5~0~0~0') {print "ok $n\n";} else {print "not ok $n\n";} # 21 $n++; if ($lang eq 'Svenska') {print "ok $n\n";} else {print "not ok $n\n";} # 22 $n++; if (Language_to_Text(Language()) eq 'suomi') {print "ok $n\n";} else {print "not ok $n\n";} # 23 $n++; $lang = ''; $format = sub { $lang = Language_to_Text($_[2]); die "Let's see if the language is restored nevertheless!"; }; if ($lang eq '') {print "ok $n\n";} else {print "not ok $n\n";} # 24 $n++; if ($text eq '') {print "ok $n\n";} else {print "not ok $n\n";} # 25 $n++; eval { $text = $date->string($format, 4); }; if ($@ =~ /\bDate::Calc::string\(\): Let's see if the language is restored nevertheless!/) {print "ok $n\n";} else {print "not ok $n\n";} # 26 $n++; if (Language_to_Text(Language()) eq 'suomi') {print "ok $n\n";} else {print "not ok $n\n";} # 27 $n++; if ($lang eq 'Espańol') {print "ok $n\n";} else {print "not ok $n\n";} # 28 $n++; if ($text eq '') {print "ok $n\n";} else {print "not ok $n\n";} # 29 $n++; if ("$date" eq 'Domingo, dia 5 de agosto de 2001') {print "ok $n\n";} else {print "not ok $n\n";} # 30 $n++; exit 0; # vital here: avoid "panic: POPSTACK" in Perl 5.005_03 (and before, probably) __END__ Date-Calc-6.3/t/f019.t000644 100660 100660 00000005223 11272757315 013274 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Days_in_Month ); # ====================================================================== # $days = Days_in_Month($year,$mm); # ====================================================================== print "1..26\n"; $n = 1; eval { Days_in_Month(1964,0); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,1) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,2) == 29) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,3) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,4) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,5) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,6) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,7) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,8) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,9) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,10) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,11) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1964,12) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Days_in_Month(1995,0); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,1) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,2) == 28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,3) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,4) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,5) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,6) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,7) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,8) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,9) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,10) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,11) == 30) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Days_in_Month(1995,12) == 31) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f022.t000644 100660 100660 00000007541 11272757315 013273 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Delta_DHMS Add_Delta_DHMS ); # ====================================================================== # ($days,$hh,$mm,$ss) = Delta_DHMS # ( # $year1,$month1,$day1,$hh1,$mm1,$ss1, # $year2,$month2,$day2,$hh2,$mm2,$ss2 # ); # ====================================================================== # ====================================================================== # ($year,$month,$day,$hh,$mm,$ss) = Add_Delta_DHMS # ( # $year,$month,$day,$hh,$mm,$ss, # $days_offset,$hh_offset,$mm_offset,$ss_offset # ); # ====================================================================== print "1..16\n"; $n = 1; ($dd,$h,$m,$s) = Delta_DHMS(1996,5,23,23,58,2,1996,5,25,0,1,1); if (($dd == 1) && ($h == 0) && ($m == 2) && ($s == 59)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($dd,$h,$m,$s) = Delta_DHMS(1996,5,25,0,1,1,1996,5,23,23,58,2); if (($dd == -1) && ($h == 0) && ($m == -2) && ($s == -59)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1996,5,23,23,58,2,1,0,2,59); if (($yy == 1996) && ($mm == 5) && ($dd == 25) && ($h == 0) && ($m == 1) && ($s == 1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1996,5,25,0,1,1,-1,0,-2,-59); if (($yy == 1996) && ($mm == 5) && ($dd == 23) && ($h == 23) && ($m == 58) && ($s == 2)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($dd,$h,$m,$s) = Delta_DHMS(1996,5,25,18,12,8,1996,6,15,14,12,8); if (($dd == 20) && ($h == 20) && ($m == 0) && ($s == 0)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($dd,$h,$m,$s) = Delta_DHMS(1996,6,15,14,12,8,1996,5,25,18,12,8); if (($dd == -20) && ($h == -20) && ($m == 0) && ($s == 0)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1996,5,25,18,12,8,0,500,0,0); if (($yy == 1996) && ($mm == 6) && ($dd == 15) && ($h == 14) && ($m == 12) && ($s == 8)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1996,6,15,14,12,8,0,-500,0,0); if (($yy == 1996) && ($mm == 5) && ($dd == 25) && ($h == 18) && ($m == 12) && ($s == 8)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($dd,$h,$m,$s) = Delta_DHMS(1996,5,25,18,12,8,1996,6,6,7,58,31); if (($dd == 11) && ($h == 13) && ($m == 46) && ($s == 23)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($dd,$h,$m,$s) = Delta_DHMS(1996,6,6,7,58,31,1996,5,25,18,12,8); if (($dd == -11) && ($h == -13) && ($m == -46) && ($s == -23)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1996,5,25,18,12,8,0,0,0,999983); if (($yy == 1996) && ($mm == 6) && ($dd == 6) && ($h == 7) && ($m == 58) && ($s == 31)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1996,6,6,7,58,31,0,0,0,-999983); if (($yy == 1996) && ($mm == 5) && ($dd == 25) && ($h == 18) && ($m == 12) && ($s == 8)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($dd,$h,$m,$s) = Delta_DHMS(1964,1,3,11,0,0,1996,5,25,18,12,8); if (($dd == 11831) && ($h == 7) && ($m == 12) && ($s == 8)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($dd,$h,$m,$s) = Delta_DHMS(1996,5,25,18,12,8,1964,1,3,11,0,0); if (($dd == -11831) && ($h == -7) && ($m == -12) && ($s == -8)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1964,1,3,11,0,0,11831,7,12,8); if (($yy == 1996) && ($mm == 5) && ($dd == 25) && ($h == 18) && ($m == 12) && ($s == 8)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1996,5,25,18,12,8,-11831,-7,-12,-8); if (($yy == 1964) && ($mm == 1) && ($dd == 3) && ($h == 11) && ($m == 0) && ($s == 0)) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f003.t000644 100660 100660 00000001622 11272757315 013264 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Compress ); # ====================================================================== # $date = Compress($yy,$mm,$dd); # ====================================================================== print "1..6\n"; $n = 1; if (Compress(64,1,3) == 48163) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compress(1964,1,3) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compress(95,11,18) == 13170) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compress(1995,11,18) == 13170) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compress(1995,2,28) == 12892) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compress(1995,2,29) == 0) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f002.t000644 100660 100660 00000002427 11272757315 013267 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( check_date ); # ====================================================================== # $flag = check_date($year,$mm,$dd); # ====================================================================== print "1..11\n"; $n = 1; if (check_date(1,1,1) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(0,1,1) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1,0,1) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1,1,0) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(-1,1,1) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1,-1,1) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1,1,-1) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1964,1,3) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1964,2,29) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1995,2,28) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(1995,2,29) == 0) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f023.t000644 100660 100660 00000010026 11272757315 013264 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Delta_DHMS ); # ====================================================================== # ($days,$hh,$mm,$ss) = Delta_DHMS # ( # $year1,$month1,$day1,$hh1,$mm1,$ss1, # $year2,$month2,$day2,$hh2,$mm2,$ss2 # ); # ====================================================================== print "1..21\n"; $n = 1; if ((($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,7,58,31,1995,2,28,18,12,8)) && ($dd == 0) && ($h == 10) && ($m == 13) && ($s == 37)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,28,7,58,31)) && ($dd == 0) && ($h == -10) && ($m == -13) && ($s == -37)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,3,1,7,58,31)) && ($dd == 0) && ($h == 13) && ($m == 46) && ($s == 23)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($dd,$h,$m,$s) = Delta_DHMS(1995,3,1,18,12,8,1995,2,28,7,58,31)) && ($dd == -1) && ($h == -10) && ($m == -13) && ($s == -37)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,29,18,12,8,1995,2,28,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,29,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,29,18,12,8,1995,2,29,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,-1,12,8,1995,2,28,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,-1,8,1995,2,28,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,-1,1995,2,28,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,28,-1,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,28,7,-1,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,28,7,58,-1); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,24,12,8,1995,2,28,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,60,8,1995,2,28,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,60,1995,2,28,7,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,28,24,58,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,28,7,60,31); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($dd,$h,$m,$s) = Delta_DHMS(1995,2,28,18,12,8,1995,2,28,7,58,60); }; if ($@ =~ /not a valid (?:date|time)/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($dd,$h,$m,$s) = Delta_DHMS(1964,1,3,11,4,0,1997,2,13,22,51,31)) && ($dd == 12095) && ($h == 11) && ($m == 47) && ($s == 31)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($dd,$h,$m,$s) = Delta_DHMS(1997,2,13,22,51,31,1964,1,3,11,4,0)) && ($dd == -12095) && ($h == -11) && ($m == -47) && ($s == -31)) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/m004.t000644 100660 100660 00000002742 11272757315 013300 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); # ====================================================================== # $lang = Date::Calc->language([LANG]); # $lang = $date->language([LANG]); # ====================================================================== print "1..9\n"; $n = 1; $date = Date::Calc->new(); $lang = Date::Calc->language(); if ($lang eq 'English') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $lang = Date::Calc->language("fr"); if ($lang eq 'English') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $lang = Date::Calc->language(); if ($lang eq 'Français') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $lang = $date->language(); unless (defined $lang) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $lang = $date->language("SV"); unless (defined $lang) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $lang = $date->language(); if ($lang eq 'Svenska') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $lang = $date->language(3); if ($lang eq 'Svenska') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $lang = $date->language(); if ($lang eq 'Deutsch') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date->[0][3] = 0; eval { $lang = $date->language(); }; if ($@ =~ /\bDate::Calc::language\(\): language not available\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f018.t000644 100660 100660 00000014356 11272757315 013302 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Month_to_Text ); # ====================================================================== # $month = Month_to_Text($mm); # ====================================================================== print "1..63\n"; $n = 1; eval { Month_to_Text(0); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(1) eq "January") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(2) eq "February") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(3) eq "March") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(4) eq "April") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(5) eq "May") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(6) eq "June") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(7) eq "July") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(8) eq "August") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(9) eq "September") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(10) eq "October") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(11) eq "November") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(12) eq "December") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(1,0) eq "January") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(2,0) eq "February") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(3,0) eq "March") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(4,0) eq "April") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(5,0) eq "May") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(6,0) eq "June") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(7,0) eq "July") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(8,0) eq "August") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(9,0) eq "September") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(10,0) eq "October") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(11,0) eq "November") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(12,0) eq "December") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(1,1) eq "January") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(2,1) eq "February") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(3,1) eq "March") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(4,1) eq "April") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(5,1) eq "May") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(6,1) eq "June") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(7,1) eq "July") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(8,1) eq "August") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(9,1) eq "September") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(10,1) eq "October") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(11,1) eq "November") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(12,1) eq "December") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(1,6) eq "januari") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(2,6) eq "februari") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(3,6) eq "maart") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(4,6) eq "april") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(5,6) eq "mei") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(6,6) eq "juni") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(7,6) eq "juli") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(8,6) eq "augustus") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(9,6) eq "september") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(10,6) eq "oktober") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(11,6) eq "november") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Month_to_Text(12,6) eq "december") {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(13); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(14,0); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(15,1); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(16,()); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(17,); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(18); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(19); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(20); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(21); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(22); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(23); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(24); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(25); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Month_to_Text(26); }; if ($@ =~ /month out of range/) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f029.t000644 100660 100660 00000010024 11272757315 013270 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Add_Delta_YMD ); # ====================================================================== # ($year,$mm,$dd) = Add_Delta_YMD($year, $mm, $dd, # $y_offs,$m_offs,$d_offs); # ====================================================================== print "1..23\n"; $n = 1; eval { ($year,$mm,$dd) = Add_Delta_YMD(0,0,0,0,0,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_YMD(0,2,28,0,0,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_YMD(1997,0,28,0,0,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_YMD(1997,2,0,0,0,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_YMD(1997,2,29,0,0,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(1996,2,29,0,0,0)) && ($year==1996) && ($mm==2) && ($dd==29)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(1992,2,29,4,0,0)) && ($year==1996) && ($mm==2) && ($dd==29)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(1996,2,29,1,0,0)) && ($year==1997) && ($mm==3) && ($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(1997,1,29,0,1,0)) && ($year==1997) && ($mm==3) && ($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(1996,2,28,0,0,1)) && ($year==1996) && ($mm==2) && ($dd==29)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(1997,2,28,0,0,1)) && ($year==1997) && ($mm==3) && ($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_YMD(1,1,1,0,0,-1); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_YMD(1,1,1,0,-1,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Add_Delta_YMD(1,1,1,-1,0,0); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($year,$mm,$dd) = (1997,2,26); ($y,$m,$d) = (0,-1,17); if ((($year,$mm,$dd) = Add_Delta_YMD($year,$mm,$dd, $y,$m,$d)) && ($year==1997) && ($mm==2) && ($dd==12)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD($year,$mm,$dd, -$y,-$m,-$d)) && ($year==1997) && ($mm==2) && ($dd==23)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($year,$mm,$dd) = (1997,2,15); ($y,$m,$d) = (0,1,-17); if ((($year,$mm,$dd) = Add_Delta_YMD($year,$mm,$dd, $y,$m,$d)) && ($year==1997) && ($mm==2) && ($dd==26)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD($year,$mm,$dd, -$y,-$m,-$d)) && ($year==1997) && ($mm==2) && ($dd==12)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($year,$mm,$dd) = (1997,2,15); ($y,$m,$d) = (1,-24,14); if ((($year,$mm,$dd) = Add_Delta_YMD($year,$mm,$dd, $y,$m,$d)) && ($year==1996) && ($mm==2) && ($dd==29)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD($year,$mm,$dd, -$y,-$m,-$d)) && ($year==1997) && ($mm==2) && ($dd==15)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(1998,1,30,0,1,0)) && ($year==1998) && ($mm==3) && ($dd==2)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(2000,1,30,0,1,0)) && ($year==2000) && ($mm==3) && ($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Add_Delta_YMD(2000,1,31,0,3,0)) && ($year==2000) && ($mm==5) && ($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f008.t000644 100660 100660 00000001735 11272757315 013276 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Delta_Days ); # ====================================================================== # $days = Delta_Days($year1,$mm1,$dd1,$year2,$mm2,$dd2); # ====================================================================== print "1..5\n"; $n = 1; if (Delta_Days(1964,1,3,1995,11,18) == 11642) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Delta_Days(1995,11,18,1964,1,3) == -11642) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Delta_Days(1964,1,3,1995,2,29); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Delta_Days(1964,2,30,1995,11,18); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Delta_Days(1964,2,30,1995,2,29); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f033.t000644 100660 100660 00000002052 11272757315 013265 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Standard_to_Business Business_to_Standard Add_Delta_Days ); # ====================================================================== # ($year,$week,$dow) = Standard_to_Business($year,$month,$day); # ($year,$month,$day) = Business_to_Standard($year,$week,$dow); # ====================================================================== $y1 = 1964; $y2 = 2000; $d1 = -8; $d2 = +8; print "1..", ($y2-$y1+1) * ($d2-$d1+1), "\n"; $n = 1; for ( $year = $y1; $year <= $y2; $year++ ) { for ( $delta = $d1; $delta <= $d2; $delta++ ) { @date = Add_Delta_Days($year,1,1,$delta); @business = Standard_to_Business(@date); @standard = Business_to_Standard(@business); if (($standard[0] == $date[0]) && ($standard[1] == $date[1]) && ($standard[2] == $date[2])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } } __END__ Date-Calc-6.3/t/f012.t000644 100660 100660 00000011122 11272757315 013260 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Date_to_Text_Long Language Decode_Language ); # ====================================================================== # $datestr = Date_to_Text_Long($year,$mm,$dd); # ====================================================================== print "1..35\n"; $n = 1; if (Date_to_Text_Long(1964,1,3) eq "Friday, January 3rd 1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1995,11,18) eq "Saturday, November 18th 1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1999,12,31) eq "Friday, December 31st 1999") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,1) eq "Saturday, January 1st 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,2) eq "Sunday, January 2nd 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; Language(Decode_Language("DE")); if (Date_to_Text_Long(1964,1,3) eq "Freitag, den 3. Januar 1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1995,11,18) eq "Samstag, den 18. November 1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1999,12,31) eq "Freitag, den 31. Dezember 1999") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,1) eq "Samstag, den 1. Januar 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,2) eq "Sonntag, den 2. Januar 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; Language(Decode_Language("FR")); if (Date_to_Text_Long(1964,1,3) eq "Vendredi 3 janvier 1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1995,11,18) eq "Samedi 18 novembre 1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1999,12,31) eq "Vendredi 31 décembre 1999") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,1) eq "Samedi 1 janvier 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,2) eq "Dimanche 2 janvier 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1964,1,3,0) eq "Vendredi 3 janvier 1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1995,11,18,0) eq "Samedi 18 novembre 1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1999,12,31,0) eq "Vendredi 31 décembre 1999") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,1,0) eq "Samedi 1 janvier 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,2,0) eq "Dimanche 2 janvier 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1964,1,3,1) eq "Friday, January 3rd 1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1995,11,18,1) eq "Saturday, November 18th 1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1999,12,31,1) eq "Friday, December 31st 1999") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,1,1) eq "Saturday, January 1st 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,2,1) eq "Sunday, January 2nd 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1964,1,3,2) eq "Vendredi 3 janvier 1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1995,11,18,2) eq "Samedi 18 novembre 1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1999,12,31,2) eq "Vendredi 31 décembre 1999") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,1,2) eq "Samedi 1 janvier 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,2,2) eq "Dimanche 2 janvier 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1964,1,3,3) eq "Freitag, den 3. Januar 1964") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1995,11,18,3) eq "Samstag, den 18. November 1995") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(1999,12,31,3) eq "Freitag, den 31. Dezember 1999") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,1,3) eq "Samstag, den 1. Januar 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Text_Long(2000,1,2,3) eq "Sonntag, den 2. Januar 2000") {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f016.t000644 100660 100660 00000007661 11272757315 013301 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Decode_Date_EU Decode_Date_US ); # ====================================================================== # ($year,$mm,$dd) = Decode_Date_EU($buffer); # ($year,$mm,$dd) = Decode_Date_US($buffer); # ====================================================================== print "1..25\n"; $n = 1; if ((($year,$mm,$dd) = Decode_Date_EU("3.1.64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("3 1 64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("03.01.64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("03/01/64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("3. Ene 1964",4)) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("Geburtstag: 3. Januar '64 in Backnang/Württemberg",3)) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("03-Jan-64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("3.Jan1964",6)) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("3Jan64",0)) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("030164")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("3ja64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("3164")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_EU("28.2.1995")) && ($year==1995)&&($mm==2)&&($dd==28)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_EU("29.2.1995")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("1 3 64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("01/03/64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("Jan 3 '64")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("Jan 3 1964")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("===> January 3rd 1964 (birthday)")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("Jan31964")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("Jan364")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("ja364")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("1364")) && ($year==1964)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US("2.28.1995")) && ($year==1995)&&($mm==2)&&($dd==28)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_US("2.29.1995")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f037.t000644 100660 100660 00000025414 11272757315 013300 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw(:all); # ====================================================================== # # ($Dy,$Dm,$Dd) = N_Delta_YMD($year1,$month1,$day1, # $year2,$month2,$day2); # # ($D_y,$D_m,$D_d, $Dhh,$Dmm,$Dss) = N_Delta_YMDHMS($year1,$month1,$day1, $hour1,$min1,$sec1, # $year2,$month2,$day2, $hour2,$min2,$sec2); # # ($year,$month,$day) = Add_N_Delta_YMD($year,$month,$day, $Dy,$Dm,$Dd); # # ($year,$month,$day, $hour,$min,$sec) = Add_N_Delta_YMDHMS($year,$month,$day, $hour,$min,$sec, # $D_y, $D_m, $D_d, $Dhh, $Dmm,$Dss); # # ====================================================================== $tests = (17 + 20) * 6 + 13; print "1..$tests\n"; $n = 1; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(0,2,28,1996,2,29); }; # 01 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1997,0,28,1996,2,29); }; # 02 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1997,2,0,1996,2,29); }; # 03 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1997,2,29,1996,2,29); }; # 04 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1996,2,29,0,2,28); }; # 05 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1996,2,29,1997,0,28); }; # 06 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1996,2,29,1997,2,0); }; # 07 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1996,2,29,1997,2,29); }; # 08 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { ($d_y, $d_m, $d_d) = N_Delta_YMD(1996,2,29,1997,2,28); }; # 09 unless ($@) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { (@diff) = N_Delta_YMDHMS(1996,2,29,23,59,59,1997,2,29,0,0,1); }; # 10 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { (@diff) = N_Delta_YMDHMS(1997,2,29,23,59,59,1996,2,29,0,0,1); }; # 11 if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { (@diff) = N_Delta_YMDHMS(1996,2,29,24,59,59,1997,2,28,0,0,1); }; # 12 if ($@ =~ /not a valid time/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; eval { (@diff) = N_Delta_YMDHMS(1996,2,29,23,59,59,1997,2,28,0,60,1); }; # 13 if ($@ =~ /not a valid time/) {print "ok $n\n";} else {print "not ok $n\n$@\n";} $n++; &try( [2008, 1, 3], [2009, 8,21], [ 1, 7,18] ); # 01 &try( [2009, 8,26], [2011, 7,27], [ 1,11, 1] ); # 02 &try( [1964, 1, 3], [2009, 8,26], [45, 7,23] ); # 03 &try( [2009, 1,31], [2009, 2,28], [ 0, 0,28] ); # 04 &try( [2009, 2,28], [2009, 3,31], [ 0, 1, 3], [0, -1, 0] ); # 05 &try( [2008, 1,31], [2009, 1, 1], [ 0,11, 1] ); # 06 &try( [2008, 2,29], [2009, 2, 1], [ 0,11, 3], [0,-11, -1] ); # 07 &try( [2008, 3,31], [2009, 3, 1], [ 0,11, 1] ); # 08 &try( [1996, 2,29], [1997, 2,28], [ 1, 0, 0], [0,-11,-28] ); # 09 &try( [2009, 1,31], [2009, 3, 2], [ 0, 0,30] ); # 10 &try( [2009, 1,30], [2009, 3, 1], [ 0, 0,30] ); # 11 &try( [2008, 1,31], [2008, 3, 1], [ 0, 0,30] ); # 12 &try( [2008, 2,15], [2008, 3,15], [ 0, 0,29] ); # 13 &try( [2009, 2,15], [2009, 3,15], [ 0, 0,28] ); # 14 &try( [2007, 2, 1], [2008, 1,31], [ 0,11,30], [0,-11,-27] ); # 15 &try( [2007, 2,28], [2008, 1, 1], [ 0,10, 4], [0,-10, -1] ); # 16 &try( [2008, 1,31], [2009, 2, 1], [ 1, 0, 1] ); # 17 &try2( [2008, 1, 3, 0, 0, 0], [2009, 8,21, 23, 59, 59], [ 1, 7,18, 23, 59, 59] ); # 01 &try2( [2009, 8,26, 0, 0, 0], [2011, 7,27, 0, 0, 0], [ 1,11, 1, 0, 0, 0] ); # 02 &try2( [1964, 1, 3, 11, 7, 55], [2009, 8,26, 8, 39, 40], [45, 7,22, 21, 31, 45] ); # 03 &try2( [2009, 1,31, 23, 59, 59], [2009, 2,28, 0, 1, 0], [ 0, 0,27, 0, 1, 1] ); # 04 &try2( [2009, 2,28, 0, 0, 2], [2009, 3,31, 0, 0, 1], [ 0, 1, 2, 23, 59, 59], [0,0,-30,-23,-59,-59] ); # 05 &try2( [2009, 2,28, 0, 0, 2], [2009, 3, 1, 0, 0, 1], [ 0, 0, 0, 23, 59, 59] ); # 06 &try2( [2009, 1, 1, 0, 0, 2], [2009, 2, 1, 0, 0, 1], [ 0, 0,30, 23, 59, 59] ); # 07 &try2( [2008, 2,29, 0, 0, 2], [2009, 2,28, 0, 0, 1], [ 0,11,29, 23, 59, 59], [0,-11,-27,-23,-59,-59] ); # 08 &try2( [2008, 1,31, 23, 59, 58], [2009, 1, 1, 0, 0, 1], [ 0,11, 0, 0, 0, 3] ); # 09 &try2( [2008, 2,29, 0, 2, 0], [2009, 2, 1, 0, 0, 1], [ 0,11, 2, 23, 58, 1], [0,-11,0,-23,-58,-1] ); # 10 &try2( [2008, 3,31, 0, 2, 0], [2009, 3, 1, 0, 0, 1], [ 0,11, 0, 23, 58, 1] ); # 11 &try2( [1996, 2,29, 8, 11, 27], [1997, 2,28, 16, 45, 10], [ 1, 0, 0, 8, 33, 43], [0,-11,-28,-8,-33,-43] ); # 12 &try2( [2009, 1,31, 23, 59, 59], [2009, 3, 2, 0, 0, 1], [ 0, 0,29, 0, 0, 2] ); # 13 &try2( [2009, 1,30, 23, 59, 59], [2009, 3, 1, 0, 0, 1], [ 0, 0,29, 0, 0, 2] ); # 14 &try2( [2008, 1,31, 23, 59, 59], [2008, 3, 1, 0, 0, 1], [ 0, 0,29, 0, 0, 2] ); # 15 &try2( [2008, 2,15, 23, 59, 59], [2008, 3,15, 0, 0, 1], [ 0, 0,28, 0, 0, 2] ); # 16 &try2( [2009, 2,15, 0, 0, 0], [2009, 3,15, 0, 0, 0], [ 0, 0,28, 0, 0, 0] ); # 17 &try2( [2007, 2, 1, 0, 0, 1], [2008, 1,31, 0, 0, 0], [ 0,11,29, 23, 59, 59], [0,-11,-26,-23,-59,-59] ); # 18 &try2( [2007, 2,28, 0, 2, 0], [2008, 1, 1, 0, 0, 1], [ 0,10, 3, 23, 58, 1], [0,-10,0,-23,-58,-1] ); # 19 &try2( [2008, 1,31, 0, 0, 0], [2009, 2, 1, 0, 1, 0], [ 1, 0, 1, 0, 1, 0] ); # 20 sub try { my($d1) = shift; my($d2) = shift; my($dd) = shift; my(@tt,@cc,@ee); #print "&try( [", join(',',@$d1), "], [", join(',',@$d2), "], [", join(',',@$dd), "] );\n"; @tt = N_Delta_YMD(@$d1,@$d2); #print "diff: (", join(',',@tt), ")\n"; @cc = Add_Delta_Days( Add_Delta_YM(@$d1,@tt[0,1]), $tt[2] ); @ee = Add_N_Delta_YMD(@$d1,@tt); #print "check: (", join(',',@cc), ")\n"; if (($tt[0] == $dd->[0]) and ($tt[1] == $dd->[1]) and ($tt[2] == $dd->[2])) {print "ok $n\n";} else {print "not ok $n\n($tt[0],$tt[1],$tt[2]) != ($dd->[0],$dd->[1],$dd->[2])\n";} # 01 $n++; if (($cc[0] == $d2->[0]) and ($cc[1] == $d2->[1]) and ($cc[2] == $d2->[2])) {print "ok $n\n";} else {print "not ok $n\n($cc[0],$cc[1],$cc[2]) != ($d2->[0],$d2->[1],$d2->[2])\n";} # 02 $n++; if (($ee[0] == $d2->[0]) and ($ee[1] == $d2->[1]) and ($ee[2] == $d2->[2])) {print "ok $n\n";} else {print "not ok $n\n($ee[0],$ee[1],$ee[2]) != ($d2->[0],$d2->[1],$d2->[2])\n";} # 03 $n++; if (@_ > 0) { $dd = shift; } else { $dd->[0] = -$dd->[0]; $dd->[1] = -$dd->[1]; $dd->[2] = -$dd->[2]; } @tt = N_Delta_YMD(@$d2,@$d1); #print "diff: (", join(',',@tt), ")\n"; # @cc = Add_Delta_YM(@$d2,@tt[0,1]); #print "check: (", join(',',@cc), ")\n"; # @cc = Add_Delta_Days( @cc, $tt[2] ); @cc = Add_Delta_Days( Add_Delta_YM(@$d2,@tt[0,1]), $tt[2] ); @ee = Add_N_Delta_YMD(@$d2,@tt); #print "check: (", join(',',@cc), ")\n"; if (($tt[0] == $dd->[0]) and ($tt[1] == $dd->[1]) and ($tt[2] == $dd->[2])) {print "ok $n\n";} else {print "not ok $n\n($tt[0],$tt[1],$tt[2]) != ($dd->[0],$dd->[1],$dd->[2])\n";} # 04 $n++; if (($cc[0] == $d1->[0]) and ($cc[1] == $d1->[1]) and ($cc[2] == $d1->[2])) {print "ok $n\n";} else {print "not ok $n\n($cc[0],$cc[1],$cc[2]) != ($d1->[0],$d1->[1],$d1->[2])\n";} # 05 $n++; if (($ee[0] == $d1->[0]) and ($ee[1] == $d1->[1]) and ($ee[2] == $d1->[2])) {print "ok $n\n";} else {print "not ok $n\n($ee[0],$ee[1],$ee[2]) != ($d1->[0],$d1->[1],$d1->[2])\n";} # 06 $n++; } sub try2 { my($d1) = shift; my($d2) = shift; my($dd) = shift; my(@tt,@cc,@ee); @tt = N_Delta_YMDHMS(@$d1,@$d2); @cc = Add_Delta_DHMS( Add_Delta_YM(@{$d1}[0..2],@tt[0,1]), @{$d1}[3..5], @tt[2..5] ); @ee = Add_N_Delta_YMDHMS(@$d1,@tt); if (($tt[0] == $dd->[0]) and ($tt[1] == $dd->[1]) and ($tt[2] == $dd->[2]) and ($tt[3] == $dd->[3]) and ($tt[4] == $dd->[4]) and ($tt[5] == $dd->[5])) {print "ok $n\n";} else {print "not ok $n\n($tt[0],$tt[1],$tt[2],$tt[3],$tt[4],$tt[5]) != ($dd->[0],$dd->[1],$dd->[2],$dd->[3],$dd->[4],$dd->[5])\n";} # 01 $n++; if (($cc[0] == $d2->[0]) and ($cc[1] == $d2->[1]) and ($cc[2] == $d2->[2]) and ($cc[3] == $d2->[3]) and ($cc[4] == $d2->[4]) and ($cc[5] == $d2->[5])) {print "ok $n\n";} else {print "not ok $n\n($cc[0],$cc[1],$cc[2],$cc[3],$cc[4],$cc[5]) != ($d2->[0],$d2->[1],$d2->[2],$d2->[3],$d2->[4],$d2->[5])\n";} # 02 $n++; if (($ee[0] == $d2->[0]) and ($ee[1] == $d2->[1]) and ($ee[2] == $d2->[2]) and ($ee[3] == $d2->[3]) and ($ee[4] == $d2->[4]) and ($ee[5] == $d2->[5])) {print "ok $n\n";} else {print "not ok $n\n($ee[0],$ee[1],$ee[2],$ee[3],$ee[4],$ee[5]) != ($d2->[0],$d2->[1],$d2->[2],$d2->[3],$d2->[4],$d2->[5])\n";} # 03 $n++; if (@_ > 0) { $dd = shift; } else { $dd->[0] = -$dd->[0]; $dd->[1] = -$dd->[1]; $dd->[2] = -$dd->[2]; $dd->[3] = -$dd->[3]; $dd->[4] = -$dd->[4]; $dd->[5] = -$dd->[5]; } @tt = N_Delta_YMDHMS(@$d2,@$d1); @cc = Add_Delta_DHMS( Add_Delta_YM(@{$d2}[0..2],@tt[0,1]), @{$d2}[3..5], @tt[2..5] ); @ee = Add_N_Delta_YMDHMS(@$d2,@tt); if (($tt[0] == $dd->[0]) and ($tt[1] == $dd->[1]) and ($tt[2] == $dd->[2]) and ($tt[3] == $dd->[3]) and ($tt[4] == $dd->[4]) and ($tt[5] == $dd->[5])) {print "ok $n\n";} else {print "not ok $n\n($tt[0],$tt[1],$tt[2],$tt[3],$tt[4],$tt[5]) != ($dd->[0],$dd->[1],$dd->[2],$dd->[3],$dd->[4],$dd->[5])\n";} # 04 $n++; if (($cc[0] == $d1->[0]) and ($cc[1] == $d1->[1]) and ($cc[2] == $d1->[2]) and ($cc[3] == $d1->[3]) and ($cc[4] == $d1->[4]) and ($cc[5] == $d1->[5])) {print "ok $n\n";} else {print "not ok $n\n($cc[0],$cc[1],$cc[2],$cc[3],$cc[4],$cc[5]) != ($d1->[0],$d1->[1],$d1->[2],$d1->[3],$d1->[4],$d1->[5])\n";} # 05 $n++; if (($ee[0] == $d1->[0]) and ($ee[1] == $d1->[1]) and ($ee[2] == $d1->[2]) and ($ee[3] == $d1->[3]) and ($ee[4] == $d1->[4]) and ($ee[5] == $d1->[5])) {print "ok $n\n";} else {print "not ok $n\n($ee[0],$ee[1],$ee[2],$ee[3],$ee[4],$ee[5]) != ($d1->[0],$d1->[1],$d1->[2],$d1->[3],$d1->[4],$d1->[5])\n";} # 06 $n++; } __END__ Date-Calc-6.3/t/m010.t000644 100660 100660 00000006004 11272757315 013270 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } eval { require Bit::Vector; }; if ($@) { print "1..0\n"; exit 0; } $Date::Calendar::Profiles::Profiles = $Date::Calendar::Profiles::Profiles = 0; # Avoid "used only once" warning require Date::Calc::Object; require Date::Calendar::Profiles; require Date::Calendar; Date::Calc::Object->import(':all'); # ====================================================================== # $cal = Date::Calendar->new(PROFILE[,LANG[,WEEKEND]]); # $cal->cache_add( YEAR [,YEAR]* ); # $cal->cache_del( YEAR [,YEAR]* ); # @list = $cal->cache_keys(); # @dates = $cal->search(SUBSTRING); # @labels = $cal->labels(DATE); # @dates = $year->search(SUBSTRING); # @labels = $year->labels(DATE); # ====================================================================== print "1..6\n"; $n = 1; Date::Calc->date_format(3); $cal = Date::Calendar->new( $Date::Calendar::Profiles::Profiles->{'DE-NW'}, Language(Decode_Language("Deutsch")) ); $cal->cache_add( 2000..2003,2005 ); @list = $cal->cache_keys(); if (join(',', @list) eq '2000,2001,2002,2003,2005') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $cal->cache_del( 2005 ); @list = $cal->cache_keys(); if (join(',', @list) eq '2000,2001,2002,2003') {print "ok $n\n";} else {print "not ok $n\n";} $n++; @date = $cal->search("Weiber"); $string = join( '', map( sprintf( "%s (%s)\n", $_, join( ' ', sort $cal->labels($_->date()) ) ), @date ) ); if ($string eq <<'VERBATIM') Donnerstag, den 2. März 2000 (Donnerstag Fettdonnerstag Weiberfastnacht) Donnerstag, den 22. Februar 2001 (Donnerstag Fettdonnerstag Weiberfastnacht) Donnerstag, den 7. Februar 2002 (Donnerstag Fettdonnerstag Weiberfastnacht) Donnerstag, den 27. Februar 2003 (Donnerstag Fettdonnerstag Weiberfastnacht) VERBATIM {print "ok $n\n";} else {print "not ok $n\n";} $n++; $check = join( '', map( sprintf( "%s (%s)\n", $_, join( ' ', sort $cal->year($_)->labels($_->date()) ) ), @date ) ); if ($check eq <<'VERBATIM') Donnerstag, den 2. März 2000 (Donnerstag Fettdonnerstag Weiberfastnacht) Donnerstag, den 22. Februar 2001 (Donnerstag Fettdonnerstag Weiberfastnacht) Donnerstag, den 7. Februar 2002 (Donnerstag Fettdonnerstag Weiberfastnacht) Donnerstag, den 27. Februar 2003 (Donnerstag Fettdonnerstag Weiberfastnacht) VERBATIM {print "ok $n\n";} else {print "not ok $n\n";} $n++; $year = $cal->year( 2004 ); @date = $year->search("Weiber"); $string = join( '', map( sprintf( "%s (%s)\n", $_, join( ' ', sort $cal->labels($_) ) ), @date ) ); if ($string eq <<'VERBATIM') Donnerstag, den 19. Februar 2004 (Donnerstag Fettdonnerstag Weiberfastnacht) VERBATIM {print "ok $n\n";} else {print "not ok $n\n";} $n++; $check = join( '', map( sprintf( "%s (%s)\n", $_, join( ' ', sort $year->labels($_) ) ), @date ) ); if ($check eq <<'VERBATIM') Donnerstag, den 19. Februar 2004 (Donnerstag Fettdonnerstag Weiberfastnacht) VERBATIM {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f027.t000644 100660 100660 00000016030 11272757315 013271 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Decode_Date_US2 Language Decode_Language ); # ====================================================================== # ($year,$mm,$dd) = Decode_Date_US2($date); # ====================================================================== print "1..46\n"; $n = 1; unless (($year,$mm,$dd) = Decode_Date_US2("")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_US2("__")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_US2("_13_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_134_")) && ($year==2004) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_0134_")) && ($year==2004) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_00134_")) && ($year==2004) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_1364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_01364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_001364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_10364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_010364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_0010364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_110364_")) && ($year==1964) && ($mm==11) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_0110364_")) && ($year==1964) && ($mm==11) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_00110364_")) && ($year==1964) && ($mm==11) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_1031964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_01031964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_001031964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_11031964_")) && ($year==1964) && ($mm==11) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_011031964_")) && ($year==1964) && ($mm==11) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_0011031964_")) && ($year==1964) && ($mm==11) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_1_3_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_1_3_1964_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_jan_3_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Jan_3_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_jAN_3_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_January_3_64_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_US2("_j_3_64_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2(" January 3rd, 1964 ")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Jan364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Jan0364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Jan00364_")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Jan2264_")) && ($year==1964) && ($mm==1) && ($dd==22)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Jan02264_",0)) && ($year==1964) && ($mm==1) && ($dd==22)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Jan002264_",'')) && ($year==1964) && ($mm==1) && ($dd==22)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_ja31964_",1)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_ja031964_",2)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_ja0031964_",3)) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_ja221964_",undef)) && ($year==1964) && ($mm==1) && ($dd==22)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_ja0221964_")) && ($year==1964) && ($mm==1) && ($dd==22)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_ja00221964_")) && ($year==1964) && ($mm==1) && ($dd==22)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_US2("_ja3364_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Decode_Date_US2("_ja331964_")) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("x000001x000003x000064x")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_ja_000003x000064x")) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Decode_Date_US2("_Janeiro_3_dia_tres_de_janeiro_de_1964_mil_novecentos_sessenta_e_seis_",Decode_Language("Portug"))) && ($year==1964) && ($mm==1) && ($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f006.t000644 100660 100660 00000004574 11272757315 013300 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Compressed_to_Text ); # ====================================================================== # $datestr = Compressed_to_Text($date); # ====================================================================== print "1..20\n"; $n = 1; if (Compressed_to_Text(48163) eq "03-Jan-64") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text( 0) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(13170) eq "18-Nov-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12892) eq "28-Feb-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12893) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(48163,0) eq "03-Jan-64") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text( 0,0) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(13170,0) eq "18-Nov-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12892,0) eq "28-Feb-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12893,0) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(48163,1) eq "03-Jan-64") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text( 0,1) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(13170,1) eq "18-Nov-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12892,1) eq "28-Feb-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12893,1) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(48163,11) eq "03-tam-64") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text( 0,11) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(13170,11) eq "18-mar-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12892,11) eq "28-hel-95") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Compressed_to_Text(12893,11) eq "??-???-??") {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f007.t000644 100660 100660 00000001106 11272757315 013265 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Date_to_Days ); # ====================================================================== # $days = Date_to_Days($year,$mm,$dd); # ====================================================================== print "1..2\n"; $n = 1; if (Date_to_Days(1964,1,3) == 716973) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Days(1995,11,18) == 728615) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f026.t000644 100660 100660 00000002261 11272757315 013271 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Nth_Weekday_of_Month_Year ); # ====================================================================== # ($year,$mm,$dd) = Nth_Weekday_of_Month_Year($year,$month,$wday,$nth); # ====================================================================== print "1..5\n"; $n = 1; if ((($year,$mm,$dd) = Nth_Weekday_of_Month_Year(1996,4,4,2)) && ($year==1996) && ($mm==4) && ($dd==11)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Nth_Weekday_of_Month_Year(1996,4,1,4)) && ($year==1996) && ($mm==4) && ($dd==22)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Nth_Weekday_of_Month_Year(1996,4,1,5)) && ($year==1996) && ($mm==4) && ($dd==29)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($year,$mm,$dd) = Nth_Weekday_of_Month_Year(1996,4,3,5)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Nth_Weekday_of_Month_Year(1997,2,5,1)) && ($year==1997) && ($mm==2) && ($dd==7)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/m001.t000644 100660 100660 00000043255 11272757315 013301 0ustar00sbsb000000 000000 #!perl -w package Date::Calc::Subclass; BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); @ISA = qw(Date::Calc); # Workaround for what appears to be a bug in Perl 5.003: *Date::Calc::DESTROY = *Date::Calc::DESTROY = sub { } if ($] < 5.004); # ====================================================================== # $date = Date::Calc->new(); # ====================================================================== # Crappy Perl 5.6.0 has internal refcount problems below: if ($] eq '5.006') { print "1..190\n"; } else { print "1..196\n"; } # Attempt to free unreferenced scalar at ./t/m001.t line 726 (#1) # (W internal) Perl went to decrement the reference count of a scalar to see if it # would go to 0, and discovered that it had already gone to 0 earlier, # and should have been freed, and in fact, probably was freed. This # could indicate that SvREFCNT_dec() was called too many times, or that # SvREFCNT_inc() was called too few times, or that the SV was mortalized # when it shouldn't have been, or that memory has been corrupted. $n = 1; eval { $date = Date::Calc->new(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date eq 'Date::Calc') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(0); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date eq 'Date::Calc') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date eq 'Date::Calc') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc::Subclass->new(2000,2,29); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date eq 'Date::Calc::Subclass') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 2000) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == 29) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->hours()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->minutes()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->seconds()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(1900,2,29); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (ref $date eq 'Date::Calc') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $day = $date->day(28); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $day) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($day == 28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == $day) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 1900) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->hours()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->minutes()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->seconds()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new([2000,2,29]); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == 29) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 2000) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->hours()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->minutes()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->seconds()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $other = $date->new(1964,1,3,11,5,4); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $other->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $other->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $other->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($other->day() == 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($other->month() == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($other->year() == 1964) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($other->hours() == 11) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($other->minutes() == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($other->seconds() == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == 29) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 2000) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->hours()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->minutes()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->seconds()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(0,2001,6,10,9,15,36); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == 10) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 2001) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->hours() == 9) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->minutes() == 15) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->seconds() == 36) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(1,37,5,6); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 37) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == 6) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->hours()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->minutes()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (defined $date->seconds()) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(1,0,0,13672,22,10,32); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == 13672) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->hours() == 22) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->minutes() == 10) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->seconds() == 32) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new([1,0,0,-13672,-22,-10,-32]); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_valid(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $flag = $date->is_delta(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (defined $flag) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($flag == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->year() == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->month() == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->day() == -13672) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->hours() == -22) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->minutes() == -10) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date->seconds() == -32) {print "ok $n\n";} else {print "not ok $n\n";} $n++; # Crappy Perl 5.6.0 has internal refcount problems here: if ($] ne '5.006') { eval { $date = Date::Calc->new(1,2); }; if ($@ =~ /\bwrong number of arguments\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(1,2,3,4,5); }; if ($@ =~ /\bwrong number of arguments\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new(1,2,3,4,5,6,7,8); }; if ($@ =~ /\bwrong number of arguments\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new([1,2]); }; if ($@ =~ /\bwrong number of arguments\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new([1,2,3,4,5]); }; if ($@ =~ /\bwrong number of arguments\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $date = Date::Calc->new([1,2,3,4,5,6,7,8]); }; if ($@ =~ /\bwrong number of arguments\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } __END__ Date-Calc-6.3/t/m011.t000644 100660 100660 00000010004 11272757315 013264 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } # ====================================================================== # $delta->normalize(); # ====================================================================== use Date::Calc::Object; Date::Calc->delta_format(1); Date::Calc->accurate_mode(0); print "1..20\n"; my $n = 1; my $d1 = Date::Calc->new(2001,3,9,7,35,0); my $d2 = Date::Calc->new(2002,3,9,19,30,5); my $d3 = Date::Calc->new(2001,4,8,8,30,11); my $d4 = Date::Calc->new(2002,3,9,23,0,1); my $d5 = $d1 - $d2; my $d6 = $d3 - $d4; my $d7 = $d6 + $d5; my $d8 = $d6 - $d5; if ("[$d5]" eq "[-1 +0 +0 -11 -55 -5]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$d6]" eq "[-1 +1 -1 -14 -29 -50]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$d7]" eq "[-2 +1 -1 -25 -84 -55]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$d8]" eq "[+0 +1 -1 -3 +26 -45]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($d7->number() == -715.022455) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($d8->number() == 29.212515) {print "ok $n\n";} else {print "not ok $n\n";} $n++; my $e7 = $d7->clone(); my $e8 = $d8->clone(); if ( $d7 == $e7 and $d7 eq $e7 and "$d7" eq "$e7" and $d8 == $e8 and $d8 eq $e8 and "$d8" eq "$e8") {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(1); my @time1 = $d7->normalize()->time(); my @date1 = $d7->date(); my @time2 = $d8->normalize()->time(); my @date2 = $d8->date(); if ("[" . join(' ', map(sprintf("%+d", $_), @date1, @time1)) . "]" eq "[-2 +1 -2 -2 -24 -55]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[" . join(' ', map(sprintf("%+d", $_), @date2, @time2)) . "]" eq "[+0 +1 -1 -2 -34 -45]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(0); @time1 = $e7->normalize()->time(); @date1 = $e7->date(); @time2 = $e8->normalize()->time(); @date2 = $e8->date(); if ("[" . join(' ', map(sprintf("%+d", $_), @date1, @time1)) . "]" eq "[-1 -11 -2 -2 -24 -55]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[" . join(' ', map(sprintf("%+d", $_), @date2, @time2)) . "]" eq "[+1 -11 -1 -2 -34 -45]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $main::warn = ''; $SIG{'__WARN__'} = sub { $main::warn = join('', @_); }; { local $^W = 1; $d1->normalize(); } if ($main::warn =~ /\bnormalizing a date is a no-op\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; my $delta; Date::Calc->accurate_mode(1); $delta = Date::Calc->new(1,4,40,400,40,400,4000); $delta->normalize(); if ("[$delta]" eq "[+4 +40 +401 +23 +46 +40]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = Date::Calc->new(1,-4,-40,-400,-40,-400,-4000); $delta->normalize(); if ("[$delta]" eq "[-4 -40 -401 -23 -46 -40]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = Date::Calc->new(1,+4,-40,+400,-40,+400,-4000); $delta->normalize(); if ("[$delta]" eq "[+4 -40 +398 +13 +33 +20]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = Date::Calc->new(1,-4,+40,-400,+40,-400,+4000); $delta->normalize(); if ("[$delta]" eq "[-4 +40 -398 -13 -33 -20]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(0); $delta = Date::Calc->new(1,4,40,400,40,400,4000); $delta->normalize(); if ("[$delta]" eq "[+7 +4 +401 +23 +46 +40]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = Date::Calc->new(1,-4,-40,-400,-40,-400,-4000); $delta->normalize(); if ("[$delta]" eq "[-7 -4 -401 -23 -46 -40]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = Date::Calc->new(1,+2,-40,+400,-40,+400,-4000); $delta->normalize(); if ("[$delta]" eq "[-2 +8 +398 +13 +33 +20]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = Date::Calc->new(1,-2,+40,-400,+40,-400,+4000); $delta->normalize(); if ("[$delta]" eq "[+2 -8 -398 -13 -33 -20]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f036.t000644 100660 100660 00000041276 11272757315 013303 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:aux); # ====================================================================== # $year = shift_year(\@_); # ($year,$mm,$dd) = shift_date(\@_); # ($hrs,$min,$sec) = shift_time(\@_); # ($year,$mm,$dd,$hrs,$min,$sec) = shift_datetime(\@_); # ====================================================================== print "1..81\n"; $n = 1; @today_and_now = Date::Calc::Today_and_Now(); @today = @today_and_now[0..2]; @now = @today_and_now[3..5]; $this_year = $today_and_now[0]; $shortdate = Date::Calc->new(@today); $longdate = Date::Calc->new(@today_and_now); # ====================================================================== # $year = shift_year(\@_); # ====================================================================== $year = 0; $year = shift_year([$this_year]); if ($year == $this_year) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year($this_year); }; if ($@ =~ /\binternal error - parameter is not an ARRAY ref\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $year = 0; $year = shift_year([[@today]]); if ($year == $this_year) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year([[$this_year]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $year = 0; $year = shift_year([$shortdate]); if ($year == $this_year) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $year = 0; $year = shift_year([$longdate]); if ($year == $this_year) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $year = 0; $year = shift_year([$shortdate,1]); if ($year == $this_year) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $year = 0; $year = shift_year([$longdate,1]); if ($year == $this_year) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year([[]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year([]); }; if ($@ =~ /\bnot enough input parameters for a year\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year([[1,2,3,4]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year([[@today,0]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year([[@today_and_now]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $year = 0; $year = shift_year([$this_year,1,2,3,4]); if ($year == $this_year) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $year = shift_year([{}]); }; if ($@ =~ /\binput parameter is neither ARRAY ref nor object\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; # ====================================================================== # ($year,$mm,$dd) = shift_date(\@_); # ====================================================================== @list = (); @list = shift_date([@today]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date(@today); }; if ($@ =~ /\binternal error - parameter is not an ARRAY ref\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([[@today]]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([[]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([[$today[0]]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([[@today[0,1]]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([[@today,0]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([[@today,0,0]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([[@today_and_now]]); }; if ($@ =~ /\bwrong number of elements in date constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([$shortdate]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([$longdate]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([$shortdate,1]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([$longdate,1]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([]); }; if ($@ =~ /\bnot enough input parameters for a date\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([$today[0]]); }; if ($@ =~ /\bnot enough input parameters for a date\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([@today[0,1]]); }; if ($@ =~ /\bnot enough input parameters for a date\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([@today,0]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([@today,0,0]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_date([@today_and_now]); if (@list == @today and $list[0] == $today[0] and $list[1] == $today[1] and $list[2] == $today[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_date([{}]); }; if ($@ =~ /\binput parameter is neither ARRAY ref nor object\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; # ====================================================================== # ($hrs,$min,$sec) = shift_time(\@_); # ====================================================================== @list = (); @list = shift_time([@now]); if (@list == @now and $list[0] == $now[0] and $list[1] == $now[1] and $list[2] == $now[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time(@now); }; if ($@ =~ /\binternal error - parameter is not an ARRAY ref\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([[@now]]); if (@list == @now and $list[0] == $now[0] and $list[1] == $now[1] and $list[2] == $now[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([[]]); }; if ($@ =~ /\bwrong number of elements in time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([[$now[0]]]); }; if ($@ =~ /\bwrong number of elements in time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([[@now[0,1]]]); }; if ($@ =~ /\bwrong number of elements in time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([[@now,0]]); }; if ($@ =~ /\bwrong number of elements in time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([[@now,0,0]]); }; if ($@ =~ /\bwrong number of elements in time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([[@now,@today]]); }; if ($@ =~ /\bwrong number of elements in time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([$shortdate]); if (@list == @now and $list[0] == 0 and $list[1] == 0 and $list[2] == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([$longdate]); if (@list == @now and $list[0] == $now[0] and $list[1] == $now[1] and $list[2] == $now[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([$shortdate,1]); if (@list == @now and $list[0] == 0 and $list[1] == 0 and $list[2] == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([$longdate,1]); if (@list == @now and $list[0] == $now[0] and $list[1] == $now[1] and $list[2] == $now[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([]); }; if ($@ =~ /\bnot enough input parameters for time values\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([$now[0]]); }; if ($@ =~ /\bnot enough input parameters for time values\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([@now[0,1]]); }; if ($@ =~ /\bnot enough input parameters for time values\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([@now,0]); if (@list == @now and $list[0] == $now[0] and $list[1] == $now[1] and $list[2] == $now[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([@now,0,0]); if (@list == @now and $list[0] == $now[0] and $list[1] == $now[1] and $list[2] == $now[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_time([@now,@today]); if (@list == @now and $list[0] == $now[0] and $list[1] == $now[1] and $list[2] == $now[2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_time([{}]); }; if ($@ =~ /\binput parameter is neither ARRAY ref nor object\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; # ====================================================================== # ($year,$mm,$dd,$hrs,$min,$sec) = shift_datetime(\@_); # ====================================================================== @list = (); @list = shift_datetime([@today_and_now]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == $today_and_now[3] and $list[4] == $today_and_now[4] and $list[5] == $today_and_now[5]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime(@today_and_now); }; if ($@ =~ /\binternal error - parameter is not an ARRAY ref\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([[@today_and_now]]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == $today_and_now[3] and $list[4] == $today_and_now[4] and $list[5] == $today_and_now[5]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[$today_and_now[0]]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[@today_and_now[0,1]]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[@today_and_now[0..2]]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[@today_and_now[0..3]]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[@today_and_now[0..4]]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[@today_and_now,0]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[@today_and_now,0,0]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([[@today_and_now,0,0,0]]); }; if ($@ =~ /\bwrong number of elements in date-time constant\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([$shortdate]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == 0 and $list[4] == 0 and $list[5] == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([$longdate]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == $today_and_now[3] and $list[4] == $today_and_now[4] and $list[5] == $today_and_now[5]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([$shortdate,1]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == 0 and $list[4] == 0 and $list[5] == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([$longdate,1]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == $today_and_now[3] and $list[4] == $today_and_now[4] and $list[5] == $today_and_now[5]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([]); }; if ($@ =~ /\bnot enough input parameters for a date and time\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([$today_and_now[0]]); }; if ($@ =~ /\bnot enough input parameters for a date and time\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([@today_and_now[0,1]]); }; if ($@ =~ /\bnot enough input parameters for a date and time\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([@today_and_now[0..2]]); }; if ($@ =~ /\bnot enough input parameters for a date and time\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([@today_and_now[0..3]]); }; if ($@ =~ /\bnot enough input parameters for a date and time\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([@today_and_now[0..4]]); }; if ($@ =~ /\bnot enough input parameters for a date and time\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([@today_and_now,0]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == $today_and_now[3] and $list[4] == $today_and_now[4] and $list[5] == $today_and_now[5]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([@today_and_now,0,0]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == $today_and_now[3] and $list[4] == $today_and_now[4] and $list[5] == $today_and_now[5]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @list = (); @list = shift_datetime([@today_and_now,0,0,0]); if (@list == @today_and_now and $list[0] == $today_and_now[0] and $list[1] == $today_and_now[1] and $list[2] == $today_and_now[2] and $list[3] == $today_and_now[3] and $list[4] == $today_and_now[4] and $list[5] == $today_and_now[5]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @list = shift_datetime([{}]); }; if ($@ =~ /\binput parameter is neither ARRAY ref nor object\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f017.t000644 100660 100660 00000010454 11272757315 013274 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Day_of_Week_to_Text Language_to_Text Language ); # ====================================================================== # $day = Day_of_Week_to_Text($weekday); # ====================================================================== print "1..38\n"; $n = 1; eval { Day_of_Week_to_Text(0); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(1) eq "Monday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(2) eq "Tuesday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(3) eq "Wednesday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(4) eq "Thursday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(5) eq "Friday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(6) eq "Saturday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(7) eq "Sunday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (($t = Day_of_Week_to_Text(1,0)) eq "Monday") {print "ok $n\n";} else {print "not ok $n ($t)\n";} $n++; if (Day_of_Week_to_Text(2,0) eq "Tuesday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(3,0) eq "Wednesday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(4,0) eq "Thursday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(5,0) eq "Friday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(6,0) eq "Saturday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(7,0) eq "Sunday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(1,1) eq "Monday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(2,1) eq "Tuesday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(3,1) eq "Wednesday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(4,1) eq "Thursday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(5,1) eq "Friday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(6,1) eq "Saturday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(7,1) eq "Sunday") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(1,3) eq "Montag") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(2,3) eq "Dienstag") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(3,3) eq "Mittwoch") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(4,3) eq "Donnerstag") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(5,3) eq "Freitag") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(6,3) eq "Samstag") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Day_of_Week_to_Text(7,3) eq "Sonntag") {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(8); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(9,0); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(10,1); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(11,()); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(12,()); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(13); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(14); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(15); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Day_of_Week_to_Text(16); }; if ($@ =~ /day of week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/m009.t000644 100660 100660 00000007161 11272757315 013305 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } eval { require Bit::Vector; }; if ($@) { print "1..0\n"; exit 0; } require Date::Calendar::Profiles; require Date::Calendar; # ====================================================================== # $cal = Date::Calendar->new(PROFILE); # ($date,$rest) = $cal->add_delta_workdays(DATE,OFFSET); # $diff = $cal->delta_workdays(DATE1,DATE2,INC1,INC2); # ====================================================================== print "1..24\n"; $n = 1; $cal_DE_NW = Date::Calendar->new( $Date::Calendar::Profiles::Profiles->{'DE-NW'} ); $cal_sdm_MUC = Date::Calendar->new( $Date::Calendar::Profiles::Profiles->{'sdm-MUC'} ); ($date,$rest) = $cal_DE_NW->add_delta_workdays([2000,12,4],28); if ($date == [2001,1,16]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_DE_NW->delta_workdays([2000,12,4],[2001,1,16],1,0); if ($diff == 28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($date,$rest) = $cal_sdm_MUC->add_delta_workdays([2000,12,4],28); if ($date == [2001,1,16]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_sdm_MUC->delta_workdays([2000,12,4],[2001,1,16],1,0); if ($diff == 28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($date,$rest) = $cal_DE_NW->add_delta_workdays([2001,1,16],-28); if ($date == [2000,12,4]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($date,$rest) = $cal_sdm_MUC->add_delta_workdays([2001,1,16],-28); if ($date == [2000,12,4]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_DE_NW->delta_workdays([2001,1,16],[2000,12,4],1,0); if ($diff == -28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_sdm_MUC->delta_workdays([2001,1,16],[2000,12,4],1,0); if ($diff == -28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_DE_NW->delta_workdays([2001,1,16],[2000,12,4],0,1); if ($diff == -28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_sdm_MUC->delta_workdays([2001,1,16],[2000,12,4],0,1); if ($diff == -28) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_DE_NW->delta_workdays([2001,1,16],[2000,12,4],0,0); if ($diff == -27) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_sdm_MUC->delta_workdays([2001,1,16],[2000,12,4],0,0); if ($diff == -27) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_DE_NW->delta_workdays([2001,1,16],[2000,12,4],1,1); if ($diff == -29) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = $cal_sdm_MUC->delta_workdays([2001,1,16],[2000,12,4],1,1); if ($diff == -29) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($date,$rest) = $cal_DE_NW->add_delta_workdays([2001,1,16],-29); if ($date == [2000,12,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ($date,$rest) = $cal_DE_NW->add_delta_workdays([2000,12,4],32); if ($date == [2001,1,22]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date = 0; eval { $date = $cal_DE_NW->add_delta_workdays([2000,12,4],32); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2001,1,22]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f015.t000644 100660 100660 00000001326 11272757315 013270 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Weeks_in_Year ); # ====================================================================== # $weeks = Weeks_in_Year($year); # ====================================================================== print "1..4\n"; $n = 1; if (Weeks_in_Year(1964) == 53) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Weeks_in_Year(1970) == 53) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Weeks_in_Year(1976) == 53) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Weeks_in_Year(1995) == 52) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f034.t000644 100660 100660 00000012356 11272757315 013276 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw(:all); # ====================================================================== # ($year,$month,$day, $hour,$min,$sec) = Time_to_Date([time]); # $time = Date_to_Time($year,$month,$day, $hour,$min,$sec); # ====================================================================== # ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Gmtime([time]); # ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Localtime([time]); # $time = Mktime($year,$month,$day, $hour,$min,$sec); # ====================================================================== # Unix epoch is Thu 1-Jan-1970 00:00:00 (GMT) # Classic MacOS epoch is Fri 1-Jan-1904 00:00:00 (local time) # # Unix time overflow is Tue 19-Jan-2038 03:14:07 (time=0x7FFFFFFF) # MacOS time overflow is Mon 6-Feb-2040 06:28:15 (time=0xFFFFFFFF) if ($^O eq 'MacOS') { $max_time = 0xFFFFFFFF; $epoch_vec = [1904,1,1,0,0,0,1,5]; $max_vec = [2040,2,6,6,28,15,37,1]; $match_vec = [1935,6,10,15,42,30,161,1]; } else { $max_time = 0x7FFFFFFF; $epoch_vec = [1970,1,1,0,0,0,1,4]; $max_vec = [2038,1,19,3,14,7,19,2]; $match_vec = [2001,6,10,15,42,30,161,7]; } if (@ARGV and $ARGV[0]) { $all = 1; print "1..38\n"; } else { $all = 0; print "1..30\n"; } $n = 1; @date = Time_to_Date(0); for ( $i = 0; $i < 6; $i++ ) { if ($date[$i] == $epoch_vec->[$i]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } if (Date_to_Time(@date) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; @date = Time_to_Date($max_time); for ( $i = 0; $i < 6; $i++ ) { if ($date[$i] == $max_vec->[$i]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } if (Date_to_Time(@date) == $max_time) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $time = 992187750; @date = Time_to_Date($time); for ( $i = 0; $i < 6; $i++ ) { if ($date[$i] == $match_vec->[$i]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } if (Date_to_Time(@date) == $time) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @date = Gmtime(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Days(@date[0..2]) > Date_to_Days(@{$match_vec}[0..2])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @date = Time_to_Date(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Days(@date[0..2]) > Date_to_Days(@{$match_vec}[0..2])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { @date = Localtime(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_date(@date[0..2]) and check_time(@date[3..5])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (Date_to_Days(@date[0..2]) > Date_to_Days(@{$match_vec}[0..2])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $time = Mktime(@date[0..5]); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($time > 992187750) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($all) { eval { $secs = Mktime( $max_vec->[0], $max_vec->[1], $max_vec->[2], $max_vec->[3], $max_vec->[4], $max_vec->[5] ); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ( ($secs <= $max_time) and ($secs >= $max_time-86400) ) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $secs = Mktime( $max_vec->[0], $max_vec->[1], $max_vec->[2], $max_vec->[3], $max_vec->[4], $max_vec->[5]+1 ); }; if ($@ =~ /\bDate::Calc::Mktime\(\): date out of range\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $secs = Mktime( $max_vec->[0], $max_vec->[1], $max_vec->[2], $max_vec->[3], $max_vec->[4]+1, $max_vec->[5] ); }; if ($@ =~ /\bDate::Calc::Mktime\(\): date out of range\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $secs = Mktime( $max_vec->[0], $max_vec->[1], $max_vec->[2], $max_vec->[3]+1, $max_vec->[4], $max_vec->[5] ); }; if ($@ =~ /\bDate::Calc::Mktime\(\): date out of range\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $secs = Mktime( $max_vec->[0], $max_vec->[1], $max_vec->[2]+1, $max_vec->[3], $max_vec->[4], $max_vec->[5] ); }; if ($@ =~ /\bDate::Calc::Mktime\(\): date out of range\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $secs = Mktime( $max_vec->[0], $max_vec->[1]+1, $max_vec->[2], $max_vec->[3], $max_vec->[4], $max_vec->[5] ); }; if ($@ =~ /\bDate::Calc::Mktime\(\): date out of range\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $secs = Mktime( $max_vec->[0]+1, $max_vec->[1], $max_vec->[2], $max_vec->[3], $max_vec->[4], $max_vec->[5] ); }; if ($@ =~ /\bDate::Calc::Mktime\(\): date out of range\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } __END__ Date-Calc-6.3/t/m013.t000644 100660 100660 00000021277 11272757315 013304 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); # ====================================================================== # (Miscellaneous) # ====================================================================== print "1..66\n"; $n = 1; Date::Calc->normalized_mode(1); Date::Calc->date_format(1); Date::Calc->delta_format(1); $date1 = Date::Calc->new([1999,12,6]); $date2 = Date::Calc->new([2000,6,24]); $delta = $date2 - $date1; if ("[$delta]" eq "[+0 +0 +201]") {print "ok $n\n";} else {print "not ok $n ($delta)\n";} # 01 $n++; if (abs($delta) == 201) {print "ok $n\n";} else {print "not ok $n\n";} # 02 $n++; $delta = $date1 - $date2; if ("[$delta]" eq "[+0 +0 -201]") {print "ok $n\n";} else {print "not ok $n ($delta)\n";} # 03 $n++; if (abs($delta) == -201) {print "ok $n\n";} else {print "not ok $n\n";} # 04 $n++; Date::Calc->accurate_mode(0); $delta = $date2 - $date1; if ("[$delta]" eq "[+0 +6 +18]") {print "ok $n\n";} else {print "not ok $n ($delta)\n";} # 05 $n++; if (abs($delta) == 6 * 31 + 18) {print "ok $n\n";} else {print "not ok $n\n";} # 06 $n++; $delta = $date1 - $date2; if ("[$delta]" eq "[+0 -6 -18]") {print "ok $n\n";} else {print "not ok $n ($delta)\n";} # 07 $n++; if (abs($delta) == -(6 * 31 + 18)) {print "ok $n\n";} else {print "not ok $n\n";} # 08 $n++; $date1 = Date::Calc->new([2000,1,1]); $date2 = Date::Calc->new([2000,3,1]); Date::Calc->accurate_mode(1); $delta1 = $date1 - $date2; if ("[$delta1]" eq "[+0 +0 -60]") {print "ok $n\n";} else {print "not ok $n ($delta1)\n";} # 09 $n++; if (abs($delta1) == -60) {print "ok $n\n";} else {print "not ok $n\n";} # 10 $n++; $delta1 = $date2 - $date1; if ("[$delta1]" eq "[+0 +0 +60]") {print "ok $n\n";} else {print "not ok $n ($delta1)\n";} # 11 $n++; if (abs($delta1) == 60) {print "ok $n\n";} else {print "not ok $n\n";} # 12 $n++; Date::Calc->accurate_mode(0); $delta2 = $date1 - $date2; if ("[$delta2]" eq "[+0 -2 +0]") {print "ok $n\n";} else {print "not ok $n ($delta2)\n";} # 13 $n++; if (abs($delta2) == -62) {print "ok $n\n";} else {print "not ok $n\n";} # 14 $n++; $delta2 = $date2 - $date1; if ("[$delta2]" eq "[+0 +2 +0]") {print "ok $n\n";} else {print "not ok $n ($delta2)\n";} # 15 $n++; if (abs($delta2) == 62) {print "ok $n\n";} else {print "not ok $n\n";} # 16 $n++; $temp1 = $delta1 + [2000,4,1]; $temp2 = $delta2 + [2000,4,1]; if ("[$temp1]" eq "[31-May-2000]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 17 $n++; if ("[$temp2]" eq "[01-Jun-2000]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 18 $n++; $temp1 = $delta1 + [1999,1,1]; $temp2 = $delta2 + [1999,1,1]; if ("[$temp1]" eq "[02-Mar-1999]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 19 $n++; if ("[$temp2]" eq "[01-Mar-1999]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 20 $n++; $temp1 = $delta1 + [2000,12,29]; $temp2 = $delta2 + [2000,12,29]; if ("[$temp1]" eq "[27-Feb-2001]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 21 $n++; if ("[$temp2]" eq "[28-Feb-2001]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 22 $n++; if ($date1->number(0) == 20000101) {print "ok $n\n";} else {print "not ok $n\n";} # 23 $n++; if ($date2->number(0) == 20000301) {print "ok $n\n";} else {print "not ok $n\n";} # 24 $n++; if ($temp1->number(0) == 20010227) {print "ok $n\n";} else {print "not ok $n\n";} # 25 $n++; if ($temp2->number(0) == 20010228) {print "ok $n\n";} else {print "not ok $n\n";} # 26 $n++; $date1--; if ("[$date1]" eq "[31-Dec-1999]") {print "ok $n\n";} else {print "not ok $n ($date1)\n";} # 27 $n++; $date2--; if ("[$date2]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 28 $n++; $date1++; if ("[$date1]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n ($date1)\n";} # 29 $n++; $date2++; if ("[$date2]" eq "[01-Mar-2000]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 30 $n++; $date1 -= 5; if ("[$date1]" eq "[27-Dec-1999]") {print "ok $n\n";} else {print "not ok $n ($date1)\n";} # 31 $n++; $date2 -= 5; if ("[$date2]" eq "[25-Feb-2000]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 32 $n++; $date1 += 15; if ("[$date1]" eq "[11-Jan-2000]") {print "ok $n\n";} else {print "not ok $n ($date1)\n";} # 33 $n++; $date2 += 15; if ("[$date2]" eq "[11-Mar-2000]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 34 $n++; $date1 += 366; if ("[$date1]" eq "[11-Jan-2001]") {print "ok $n\n";} else {print "not ok $n ($date1)\n";} # 35 $n++; $date2 += 365; if ("[$date2]" eq "[11-Mar-2001]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 36 $n++; $temp1 += [-1,0,+2]; if ("[$temp1]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 37 $n++; $temp2 += [-1,0,-1]; if ("[$temp2]" eq "[27-Feb-2000]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 38 $n++; eval { $temp1 -= [1,0,0]; }; if ($@ =~ /\bDate::Calc::_minus_equal_\(\): invalid date\/time\b/) {print "ok $n\n";} else {print "not ok $n\n";} # 39 $n++; $temp2 -= [1,1,0,0]; if ("[$temp2]" eq "[27-Feb-1999]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 40 $n++; $temp1 = Date::Calc->new([2000,2,29]); $temp2 = Date::Calc->new([2000,2,29]); Date::Calc->accurate_mode(1); $temp1 -= [1,1,0,0]; if ("[$temp1]" eq "[01-Mar-1999]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 41 $n++; Date::Calc->accurate_mode(0); $temp2 -= [1,1,0,0]; if ("[$temp2]" eq "[28-Feb-1999]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 42 $n++; $date1 = Date::Calc->new([2000,4,30]); $date2 = Date::Calc->new([2001,5,1]); $delta1 = Date::Calc->new([1,1,1,-29]); $delta2 = Date::Calc->new([1,1,0,1]); if (abs($delta1) == 374) {print "ok $n\n";} else {print "not ok $n\n";} # 43 $n++; if (abs($delta2) == 373) {print "ok $n\n";} else {print "not ok $n\n";} # 44 $n++; Date::Calc->accurate_mode(1); $delta = $date2 - $date1; if ("[$delta]" eq "[+0 +0 +366]") {print "ok $n\n";} else {print "not ok $n ($delta)\n";} # 45 $n++; if (abs($delta) == 366) {print "ok $n\n";} else {print "not ok $n\n";} # 46 $n++; Date::Calc->accurate_mode(0); $delta = $date2 - $date1; if ("[$delta]" eq "[+1 +0 +1]") {print "ok $n\n";} else {print "not ok $n ($delta)\n";} # 47 $n++; if (abs($delta) == 373) {print "ok $n\n";} else {print "not ok $n\n";} # 48 $n++; $temp1 = $date1 + $delta1; $temp2 = ($date1 += $delta2); if ("[$temp1]" eq "[01-May-2001]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 49 $n++; if ($temp1 == $date2) {print "ok $n\n";} else {print "not ok $n ($temp1) != ($date2)\n";} # 50 $n++; if ($temp1 eq $date2) {print "ok $n\n";} else {print "not ok $n ($temp1) ne ($date2)\n";} # 51 $n++; if ($temp1 == $date1) {print "ok $n\n";} else {print "not ok $n ($temp1) != ($date1)\n";} # 52 $n++; if ($temp1 eq $date1) {print "ok $n\n";} else {print "not ok $n ($temp1) ne ($date1)\n";} # 53 $n++; if ($temp2 == $date1) {print "ok $n\n";} else {print "not ok $n ($temp2) != ($date1)\n";} # 54 $n++; if ($temp2 eq $date1) {print "ok $n\n";} else {print "not ok $n ($temp2) ne ($date1)\n";} # 55 $n++; $temp1 = $date1 - $delta1; $temp2 = ($date2 -= $delta2); if ("[$temp1]" eq "[30-Apr-2000]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 56 $n++; if ("[$date2]" eq "[30-Apr-2000]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 57 $n++; if ("[$temp2]" eq "[30-Apr-2000]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 58 $n++; $date1 = Date::Calc->new([2000,1,1]); $date2 = Date::Calc->new([2000,3,1]); $temp1 = $date1--; if ("[$temp1]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 59 $n++; if ("[$date1]" eq "[31-Dec-1999]") {print "ok $n\n";} else {print "not ok $n ($date1)\n";} # 60 $n++; $temp2 = --$date2; if ("[$temp2]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 61 $n++; if ("[$date2]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 62 $n++; $temp2 = ++$date1; if ("[$temp2]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n ($temp2)\n";} # 63 $n++; if ("[$date1]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n ($date1)\n";} # 64 $n++; $temp1 = $date2++; if ("[$temp1]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n ($temp1)\n";} # 65 $n++; if ("[$date2]" eq "[01-Mar-2000]") {print "ok $n\n";} else {print "not ok $n ($date2)\n";} # 66 $n++; exit 0; # vital here: avoid "panic: POPSTACK" in Perl 5.005_03 (and before, probably) __END__ Date-Calc-6.3/t/m003.t000644 100660 100660 00000003212 11272757315 013270 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); # ====================================================================== # $date->date_format( sub { } ); # $date->delta_format( sub { } ); # ====================================================================== print "1..6\n"; $n = 1; $date1 = Date::Calc->new(1970,1,1); $date2 = Date::Calc->new(2001,6,10,11,12,23); $date1->delta_format( sub { return join '|', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); $date1->date_format( sub { return join ':', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); $date2->date_format( sub { return join '#', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); $date2->delta_format( sub { return join '=', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); if ("$date1" eq '1970:01:01') {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$date2" eq '2001#06#10#11#12#23') {print "ok $n\n";} else {print "not ok $n\n";} $n++; { local($^W) = 0; $date2 -= $date1; } if ("$date2" eq '00=00=11483=11=12=23') {print "ok $n\n";} else {print "not ok $n\n";} $n++; { local($^W) = 0; $date2 += $date1; } if ("$date2" eq '2001#06#10#11#12#23') {print "ok $n\n";} else {print "not ok $n\n";} $n++; { local($^W) = 0; $date1 -= $date2; } if ("$date1" eq '00|00|-11483|-11|-12|-23') {print "ok $n\n";} else {print "not ok $n\n";} $n++; { local($^W) = 0; $date1 += $date2; } if ("$date1" eq '1970:01:01:00:00:00') {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f024.t000644 100660 100660 00000003705 11272757315 013273 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Add_Delta_DHMS ); # ====================================================================== # ($year,$month,$day,$hh,$mm,$ss) = Add_Delta_DHMS # ( # $year,$month,$day,$hh,$mm,$ss, # $days_offset,$hh_offset,$mm_offset,$ss_offset # ); # ====================================================================== print "1..8\n"; $n = 1; if ((($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1995,2,28,18,12,8,0,0,0,999983)) && ($yy == 1995) && ($mm == 3) && ($dd == 12) && ($h == 7) && ($m == 58) && ($s == 31)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1995,2,29,18,12,8,0,0,0,999983); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1995,2,28,24,12,8,0,0,0,999983); }; if ($@ =~ /not a valid time/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1995,2,28,18,60,8,0,0,0,999983); }; if ($@ =~ /not a valid time/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1995,2,28,18,12,60,0,0,0,999983); }; if ($@ =~ /not a valid time/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(2,2,28,18,12,8,-58,-19,2,-1)) && ($yy == 1) && ($mm == 12) && ($dd == 31) && ($h == 23) && ($m == 14) && ($s == 7)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1,2,28,18,12,8,-57,-19,2,-1)) && ($yy == 1) && ($mm == 1) && ($dd == 1) && ($h == 23) && ($m == 14) && ($s == 7)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($yy,$mm,$dd,$h,$m,$s) = Add_Delta_DHMS(1,2,28,18,12,8,-58,-19,2,-1); }; if ($@ =~ /not a valid date/) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f005.t000644 100660 100660 00000001477 11272757315 013276 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( check_compressed ); # ====================================================================== # $flag = check_compressed($date); # ====================================================================== print "1..5\n"; $n = 1; if (check_compressed(48163) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_compressed( 0) == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_compressed(13170) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_compressed(12892) == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (check_compressed(12893) == 0) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f004.t000644 100660 100660 00000002003 11272757315 013257 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Uncompress ); # ====================================================================== # ($cc,$yy,$mm,$dd) = Uncompress($date); # ====================================================================== print "1..5\n"; $n = 1; if ((($cc,$yy,$mm,$dd) = Uncompress(48163)) && ($cc==2000)&&($yy==64)&&($mm==1)&&($dd==3)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($cc,$yy,$mm,$dd) = Uncompress(0)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($cc,$yy,$mm,$dd) = Uncompress(13170)) && ($cc==1900)&&($yy==95)&&($mm==11)&&($dd==18)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($cc,$yy,$mm,$dd) = Uncompress(12892)) && ($cc==1900)&&($yy==95)&&($mm==2)&&($dd==28)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (($cc,$yy,$mm,$dd) = Uncompress(12893)) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/t/f025.t000644 100660 100660 00000001163 11272757315 013270 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Week_of_Year Monday_of_Week ); # ====================================================================== # ($week,$year) = Week_of_Year($year,$mm,$dd); # ($year,$mm,$dd) = Monday_of_Week($week,$year); # ====================================================================== print "1..1\n"; $n = 1; ($year,$mm,$dd) = Monday_of_Week(Week_of_Year(1996,6,26)); if (($year==1996)&&($mm==6)&&($dd==24)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/m002.t000644 100660 100660 00000043231 11272757315 013274 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); # ====================================================================== # (Miscellaneous) # ====================================================================== if ($] >= 5.004) { print "1..144\n"; } else { print "1..143\n"; } $n = 1; $date1 = Date::Calc->new(1964,1,3); $date2 = Date::Calc->new(2001,7,8,15,39,57); $temp1 = $date1->clone(); if (@$date1 == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@$date1 == @$temp1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date1->[0]} == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date1->[0]} == @{$temp1->[0]}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date1}[1..$#{$date1}]) eq join("\n", @{$temp1}[1..$#{$temp1}])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date1->[0]}) eq join("\n", @{$temp1->[0]})) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date1 == $temp1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date1 eq $temp1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1->delta_format( sub { return join '|', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); if (@{$date1->[0]} == @{$temp1->[0]} + 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1->date_format( sub { return join ':', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); if (@{$date1->[0]} == @{$temp1->[0]} + 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1->language("Deutsch"); if (@{$date1->[0]} == @{$temp1->[0]} + 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp2 = Date::Calc->new(); $temp2->copy($date2); if (@$date2 == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@$date2 == @$temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date2->[0]} == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date2->[0]} == @{$temp2->[0]}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date2}[1..$#{$date2}]) eq join("\n", @{$temp2}[1..$#{$temp2}])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date2->[0]}) eq join("\n", @{$temp2->[0]})) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date2 == $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date2 eq $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2->delta_format( sub { return join '#', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); if (@{$date2->[0]} == @{$temp2->[0]} + 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2->date_format( sub { return join '=', map sprintf("%02d",$_), $_[0]->date(), $_[0]->time(); } ); if (@{$date2->[0]} == @{$temp2->[0]} + 2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2->language("Dansk"); if (@{$date2->[0]} == @{$temp2->[0]} + 3) {print "ok $n\n";} else {print "not ok $n\n";} $n++; { $warn = ''; local $^W = 1; local $SIG{'__WARN__'} = sub { $warn = join '', @_; }; eval { $temp2 -= $temp1; }; } unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($warn =~ /\bDate::Calc::_minus_equal_\(\): implicitly changed object type from date to delta vector\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$temp2" eq '+0+0+13701+15+39+57') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = Date::Calc->new(1,0,0,13701,15,39,57); if (@$diff == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@$diff == @$temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$diff->[0]} == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$diff->[0]} == @{$temp2->[0]}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$diff}[1..$#{$diff}]) eq join("\n", @{$temp2}[1..$#{$temp2}])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$diff->[0]}) eq join("\n", @{$temp2->[0]})) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($diff == $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($diff eq $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; { $warn = ''; local $^W = 1; local $SIG{'__WARN__'} = sub { $warn = join '', @_; }; eval { $diff += $temp1; }; } unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($warn =~ /\bDate::Calc::_plus_equal_\(\): implicitly changed object type from delta vector to date\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->date_format(1); if ("$diff" eq '08-Jul-2001 15:39:57') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = Date::Calc->new(1,37,6,5,15,39,57); { $warn = ''; local $^W = 1; local $SIG{'__WARN__'} = sub { $warn = join '', @_; }; eval { $diff += $temp1; }; } unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($warn =~ /\bDate::Calc::_plus_equal_\(\): implicitly changed object type from delta vector to date\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$diff" eq '08-Jul-2001 15:39:57') {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(0); $temp1 = $date1->clone(); if (@$date1 == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@$date1 == @$temp1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date1->[0]} == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date1->[0]} == @{$temp1->[0]}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date1}[1..$#{$date1}]) eq join("\n", @{$temp1}[1..$#{$temp1}])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date1->[0]}) eq join("\n", @{$temp1->[0]})) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date1 == $temp1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date1 eq $temp1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp2 = Date::Calc->new(); $temp2->copy($date2); if (@$date2 == 7) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@$date2 == @$temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date2->[0]} == 4) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (@{$date2->[0]} == @{$temp2->[0]}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date2}[1..$#{$date2}]) eq join("\n", @{$temp2}[1..$#{$temp2}])) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (join("\n", @{$date2->[0]}) eq join("\n", @{$temp2->[0]})) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date2 == $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date2 eq $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; { $warn = ''; local $^W = 1; local $SIG{'__WARN__'} = sub { $warn = join '', @_; }; eval { $temp2 -= $temp1; }; } unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($warn =~ /\bDate::Calc::_minus_equal_\(\): implicitly changed object type from date to delta vector\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$temp2" eq '37#06#05#15#39#57') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = Date::Calc->new(1,37,6,5,15,39,57); if ($diff == $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($diff eq $temp2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; { $warn = ''; local $^W = 1; local $SIG{'__WARN__'} = sub { $warn = join '', @_; }; eval { $diff += $temp1; }; } unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($warn =~ /\bDate::Calc::_plus_equal_\(\): implicitly changed object type from delta vector to date\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$diff" eq '08-Jul-2001 15:39:57') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $diff = Date::Calc->new(1,0,0,13701,15,39,57); { $warn = ''; local $^W = 1; local $SIG{'__WARN__'} = sub { $warn = join '', @_; }; eval { $diff += $temp1; }; } unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($warn =~ /\bDate::Calc::_plus_equal_\(\): implicitly changed object type from delta vector to date\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("$diff" eq '08-Jul-2001 15:39:57') {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1->time(11,4,27); if ("$date1" eq '1964:01:03:11:04:27') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $temp1 = $date1 + $date2; }; if ($@ =~ /\bDate::Calc::_plus_\(\): can't add two dates\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $date1->clone(); $temp2 = $date2->clone(); eval { $temp1 += $temp2; }; if ($@ =~ /\bDate::Calc::_plus_equal_\(\): can't add two dates\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $temp1 = $date1 x $date2; }; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator 'x' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($] >= 5.004) # Perl 5.003 coughs at the overloaded 'x=' operator { $temp1 = $date1->clone(); $temp2 = $date2->clone(); eval ' $temp1 x= $temp2; '; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator 'x=' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } if ($date1 . $date2 eq '1964:01:03:11:04:272001=07=08=15=39=57') {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $temp1 = $date1 * $date2; }; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator '\*' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $date1->clone(); $temp2 = $date2->clone(); eval { $temp1 *= $temp2; }; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator '\*=' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $temp1 = $date1 / $date2; }; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator '\/' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $date1->clone(); $temp2 = $date2->clone(); eval { $temp1 /= $temp2; }; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator '\/=' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $temp1 = $date1 % $date2; }; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator '%' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $date1->clone(); $temp2 = $date2->clone(); eval { $temp1 %= $temp2; }; if ($@ =~ /\bDate::Calc::OVERLOAD\(\): operator '%=' is unimplemented\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->date_format(1); Date::Calc->delta_format(1); $date1 = Date::Calc->new([1999,12,6]); $date2 = Date::Calc->new([2000,6,24]); Date::Calc->accurate_mode(1); $delta = $date2 - $date1; if ("[$delta]" eq "[+0 +0 +201]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta) == 201) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = $date1 - $date2; if ("[$delta]" eq "[+0 +0 -201]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta) == -201) {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(0); $delta = $date2 - $date1; if ("[$delta]" eq "[+1 -6 +18]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta) == 6 * 31 + 18) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta = $date1 - $date2; if ("[$delta]" eq "[-1 +6 -18]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta) == -(6 * 31 + 18)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1 = Date::Calc->new([2000,1,1]); $date2 = Date::Calc->new([2000,3,1]); Date::Calc->accurate_mode(1); $delta1 = $date1 - $date2; if ("[$delta1]" eq "[+0 +0 -60]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta1) == -60) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta1 = $date2 - $date1; if ("[$delta1]" eq "[+0 +0 +60]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta1) == 60) {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(0); $delta2 = $date1 - $date2; if ("[$delta2]" eq "[+0 -2 +0]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta2) == -62) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $delta2 = $date2 - $date1; if ("[$delta2]" eq "[+0 +2 +0]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta2) == 62) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $delta1 + [2000,4,1]; $temp2 = $delta2 + [2000,4,1]; if ("[$temp1]" eq "[31-May-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$temp2]" eq "[01-Jun-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $delta1 + [1999,1,1]; $temp2 = $delta2 + [1999,1,1]; if ("[$temp1]" eq "[02-Mar-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$temp2]" eq "[01-Mar-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $delta1 + [2000,12,29]; $temp2 = $delta2 + [2000,12,29]; if ("[$temp1]" eq "[27-Feb-2001]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$temp2]" eq "[01-Mar-2001]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date1->number(0) == 20000101) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date2->number(0) == 20000301) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp1->number(0) == 20010227) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp2->number(0) == 20010301) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1--; if ("[$date1]" eq "[31-Dec-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2--; if ("[$date2]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1++; if ("[$date1]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2++; if ("[$date2]" eq "[01-Mar-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1 -= 5; if ("[$date1]" eq "[27-Dec-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2 -= 5; if ("[$date2]" eq "[25-Feb-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1 += 15; if ("[$date1]" eq "[11-Jan-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2 += 15; if ("[$date2]" eq "[11-Mar-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1 += 366; if ("[$date1]" eq "[11-Jan-2001]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date2 += 365; if ("[$date2]" eq "[11-Mar-2001]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 += [-1,0,+2]; if ("[$temp1]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp2 += [-1,0,-1]; if ("[$temp2]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { $temp1 -= [1,0,0]; }; if ($@ =~ /\bDate::Calc::_minus_equal_\(\): invalid date\/time\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp2 -= [1,1,0,0]; if ("[$temp2]" eq "[01-Mar-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = Date::Calc->new([2000,2,29]); $temp2 = Date::Calc->new([2000,2,29]); Date::Calc->accurate_mode(1); $temp1 -= [1,1,0,0]; if ("[$temp1]" eq "[01-Mar-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(0); $temp2 -= [1,1,0,0]; if ("[$temp2]" eq "[01-Mar-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1 = Date::Calc->new([2000,4,30]); $date2 = Date::Calc->new([2001,5,1]); $delta1 = Date::Calc->new([1,1,1,-29]); $delta2 = Date::Calc->new([1,1,0,1]); if (abs($delta1) == 374) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta2) == 373) {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(1); $delta = $date2 - $date1; if ("[$delta]" eq "[+0 +0 +366]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta) == 366) {print "ok $n\n";} else {print "not ok $n\n";} $n++; Date::Calc->accurate_mode(0); $delta = $date2 - $date1; if ("[$delta]" eq "[+1 +1 -29]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (abs($delta) == 13 * 31 - 29) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $date1 + $delta1; $temp2 = ($date1 += $delta2); if ("[$temp1]" eq "[01-May-2001]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp1 == $date2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp1 eq $date2) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp1 == $date1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp1 eq $date1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp2 == $date1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($temp2 eq $date1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $date1 - $delta1; $temp2 = ($date2 -= $delta2); if ("[$temp1]" eq "[30-Apr-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$date2]" eq "[30-Apr-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$temp2]" eq "[30-Apr-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $date1 = Date::Calc->new([2000,1,1]); $date2 = Date::Calc->new([2000,3,1]); $temp1 = $date1--; if ("[$temp1]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$date1]" eq "[31-Dec-1999]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp2 = --$date2; if ("[$temp2]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$date2]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp2 = ++$date1; if ("[$temp2]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$date1]" eq "[01-Jan-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; $temp1 = $date2++; if ("[$temp1]" eq "[29-Feb-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ("[$date2]" eq "[01-Mar-2000]") {print "ok $n\n";} else {print "not ok $n\n";} $n++; exit 0; # vital here: avoid "panic: POPSTACK" in Perl 5.005_03 (and before, probably) __END__ Date-Calc-6.3/t/m012.t000644 100660 100660 00000010566 11272757315 013302 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc::Object qw(:all); # ====================================================================== # (Normalized Mode - Miscellaneous) # ====================================================================== $tests = (17 + 20) * 4; print "1..$tests\n"; $n = 1; Date::Calc->normalized_mode(1); Date::Calc->accurate_mode(0); Date::Calc->date_format(1); Date::Calc->delta_format(1); &try( [2008, 1, 3], [2009, 8,21], [ 1, 7,18] ); # 01 &try( [2009, 8,26], [2011, 7,27], [ 1,11, 1] ); # 02 &try( [1964, 1, 3], [2009, 8,26], [45, 7,23] ); # 03 &try( [2009, 1,31], [2009, 2,28], [ 0, 0,28] ); # 04 &try( [2009, 2,28], [2009, 3,31], [ 0, 1, 3], [0, -1, 0] ); # 05 &try( [2008, 1,31], [2009, 1, 1], [ 0,11, 1] ); # 06 &try( [2008, 2,29], [2009, 2, 1], [ 0,11, 3], [0,-11, -1] ); # 07 &try( [2008, 3,31], [2009, 3, 1], [ 0,11, 1] ); # 08 &try( [1996, 2,29], [1997, 2,28], [ 1, 0, 0], [0,-11,-28] ); # 09 &try( [2009, 1,31], [2009, 3, 2], [ 0, 0,30] ); # 10 &try( [2009, 1,30], [2009, 3, 1], [ 0, 0,30] ); # 11 &try( [2008, 1,31], [2008, 3, 1], [ 0, 0,30] ); # 12 &try( [2008, 2,15], [2008, 3,15], [ 0, 0,29] ); # 13 &try( [2009, 2,15], [2009, 3,15], [ 0, 0,28] ); # 14 &try( [2007, 2, 1], [2008, 1,31], [ 0,11,30], [0,-11,-27] ); # 15 &try( [2007, 2,28], [2008, 1, 1], [ 0,10, 4], [0,-10, -1] ); # 16 &try( [2008, 1,31], [2009, 2, 1], [ 1, 0, 1] ); # 17 &try( [2008, 1, 3, 0, 0, 0], [2009, 8,21, 23, 59, 59], [ 1, 7,18, 23, 59, 59] ); # 01 &try( [2009, 8,26, 0, 0, 0], [2011, 7,27, 0, 0, 0], [ 1,11, 1, 0, 0, 0] ); # 02 &try( [1964, 1, 3, 11, 7, 55], [2009, 8,26, 8, 39, 40], [45, 7,22, 21, 31, 45] ); # 03 &try( [2009, 1,31, 23, 59, 59], [2009, 2,28, 0, 1, 0], [ 0, 0,27, 0, 1, 1] ); # 04 &try( [2009, 2,28, 0, 0, 2], [2009, 3,31, 0, 0, 1], [ 0, 1, 2, 23, 59, 59], [0,0,-30,-23,-59,-59] ); # 05 &try( [2009, 2,28, 0, 0, 2], [2009, 3, 1, 0, 0, 1], [ 0, 0, 0, 23, 59, 59] ); # 06 &try( [2009, 1, 1, 0, 0, 2], [2009, 2, 1, 0, 0, 1], [ 0, 0,30, 23, 59, 59] ); # 07 &try( [2008, 2,29, 0, 0, 2], [2009, 2,28, 0, 0, 1], [ 0,11,29, 23, 59, 59], [0,-11,-27,-23,-59,-59] ); # 08 &try( [2008, 1,31, 23, 59, 58], [2009, 1, 1, 0, 0, 1], [ 0,11, 0, 0, 0, 3] ); # 09 &try( [2008, 2,29, 0, 2, 0], [2009, 2, 1, 0, 0, 1], [ 0,11, 2, 23, 58, 1], [0,-11,0,-23,-58,-1] ); # 10 &try( [2008, 3,31, 0, 2, 0], [2009, 3, 1, 0, 0, 1], [ 0,11, 0, 23, 58, 1] ); # 11 &try( [1996, 2,29, 8, 11, 27], [1997, 2,28, 16, 45, 10], [ 1, 0, 0, 8, 33, 43], [0,-11,-28,-8,-33,-43] ); # 12 &try( [2009, 1,31, 23, 59, 59], [2009, 3, 2, 0, 0, 1], [ 0, 0,29, 0, 0, 2] ); # 13 &try( [2009, 1,30, 23, 59, 59], [2009, 3, 1, 0, 0, 1], [ 0, 0,29, 0, 0, 2] ); # 14 &try( [2008, 1,31, 23, 59, 59], [2008, 3, 1, 0, 0, 1], [ 0, 0,29, 0, 0, 2] ); # 15 &try( [2008, 2,15, 23, 59, 59], [2008, 3,15, 0, 0, 1], [ 0, 0,28, 0, 0, 2] ); # 16 &try( [2009, 2,15, 0, 0, 0], [2009, 3,15, 0, 0, 0], [ 0, 0,28, 0, 0, 0] ); # 17 &try( [2007, 2, 1, 0, 0, 1], [2008, 1,31, 0, 0, 0], [ 0,11,29, 23, 59, 59], [0,-11,-26,-23,-59,-59] ); # 18 &try( [2007, 2,28, 0, 2, 0], [2008, 1, 1, 0, 0, 1], [ 0,10, 3, 23, 58, 1], [0,-10,0,-23,-58,-1] ); # 19 &try( [2008, 1,31, 0, 0, 0], [2009, 2, 1, 0, 1, 0], [ 1, 0, 1, 0, 1, 0] ); # 20 sub try { my($d1) = shift; my($d2) = shift; my($dd) = shift; my($tt,$cc); $d1 = Date::Calc->new(0,@{$d1}); $d2 = Date::Calc->new(0,@{$d2}); $dd = Date::Calc->new(1,@{$dd}); $tt = $d2 - $d1; $cc = $d1 + $tt; if ($tt eq $dd) {print "ok $n\n";} else {print "not ok $n\n($tt) != ($dd)\n";} # 01 $n++; if ($cc eq $d2) {print "ok $n\n";} else {print "not ok $n\n($cc) != ($d2)\n";} # 02 $n++; if (@_ > 0) { $dd = shift; $dd = Date::Calc->new(1,@{$dd}); } else { $dd->[1] = -$dd->[1]; $dd->[2] = -$dd->[2]; $dd->[3] = -$dd->[3]; if ($dd->is_long()) { $dd->[4] = -$dd->[4]; $dd->[5] = -$dd->[5]; $dd->[6] = -$dd->[6]; } } $tt = $d1 - $d2; $cc = $d2 + $tt; if ($tt eq $dd) {print "ok $n\n";} else {print "not ok $n\n($tt) != ($dd)\n";} # 03 $n++; if ($cc eq $d1) {print "ok $n\n";} else {print "not ok $n\n($cc) != ($d1)\n";} # 04 $n++; } __END__ Date-Calc-6.3/t/f035.t000644 100660 100660 00000044207 11272757315 013277 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } # ====================================================================== # use Carp::Clan qw(package::pattern); # croak(); # confess(); # carp(); # cluck(); # ====================================================================== # NOTE: Certain ugly contortions needed only for crappy Perl 5.6.0! print "1..58\n"; my $n = 1; unless (exists $main::{'croak'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (exists $main::{'confess'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (exists $main::{'carp'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (exists $main::{'cluck'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { require Carp::Clan; }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (exists $main::{'croak'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (exists $main::{'confess'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (exists $main::{'carp'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; unless (exists $main::{'cluck'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Carp::Clan->import(); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (exists $main::{'croak'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (exists $main::{'confess'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (exists $main::{'carp'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if (exists $main::{'cluck'}) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package A; sub a { &B::b(@_); } package B; sub b { &C::c(@_); } package C; sub c { &D::d(@_); } package D; sub d { &E::e(@_); } package E; sub e { &F::f(@_); } package F; eval { Carp::Clan->import(); }; sub f { my $select = shift; # Use symbolic refs without "no strict 'refs';": if ($select == 1) { &{*{${*{$main::{'F::'}}}{'croak'}}}(@_); } elsif ($select == 2) { &{*{${*{$main::{'F::'}}}{'confess'}}}(@_); } elsif ($select == 3) { &{*{${*{$main::{'F::'}}}{'carp'}}}(@_); } elsif ($select == 4) { &{*{${*{$main::{'F::'}}}{'cluck'}}}(@_); } } package main; eval { &{*{$main::{'croak'}}}("CROAKing"); }; if ($@ =~ /^.+\bCROAKing at .+$/) # no "\n" except at EOL {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &{*{$main::{'confess'}}}("CONFESSing"); }; if ($@ =~ /\bCONFESSing at .+\n.*\b(?:eval {\.\.\.}|require 0) called at\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &{*{$main::{'carp'}}}("CARPing"); }; if ($@ =~ /^.+\bCARPing at .+$/) # no "\n" except at EOL {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &{*{$main::{'cluck'}}}("CLUCKing"); }; if ($@ =~ /\bCLUCKing at .+\n.*\b(?:eval {\.\.\.}|require 0) called at\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Carp::Clan::croak("croakING"); }; if ($@ =~ /^.+\bcroakING at .+$/) # no "\n" except at EOL {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { Carp::Clan::confess("confessING"); }; if ($@ =~ /\bconfessING at .+\n.*\b(?:eval {\.\.\.}|require 0) called at\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; Carp::Clan::carp("carpING"); }; if ($@ =~ /^.+\bcarpING at .+$/) # no "\n" except at EOL {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; Carp::Clan::cluck("cluckING"); }; if ($@ =~ /\bcluckING at .+\n.*\b(?:eval {\.\.\.}|require 0) called at\b/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; ############################### # Now testing the real thing: # ############################### eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bF::f\(\): CrOaKiNg at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bF::f\(\): CaRpInG at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('^F\b'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bF::f\(\): CrOaKiNg at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bF::f\(\): CaRpInG at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('^[EF]\b'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bE::e\(\): CrOaKiNg at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bE::e\(\): CaRpInG at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('^[DEF]\b'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bD::d\(\): CrOaKiNg at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bD::d\(\): CaRpInG at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('^[CDEF]\b'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bC::c\(\): CrOaKiNg at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bC::c\(\): CaRpInG at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('^[BCDEF]\b'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bB::b\(\): CrOaKiNg at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bB::b\(\): CaRpInG at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('^[ABCDEF]\b'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bA::a\(\): CrOaKiNg at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bA::a\(\): CaRpInG at /) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('^(?:[ABCDEF]|main)\b'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bCrOaKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bE::e\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bD::d\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bC::c\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bB::b\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bA::a\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bCaRpInG\ at\ .+\n .*\bF::f\((?:\d+,\s*)*3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bE::e\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bD::d\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bC::c\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bB::b\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bA::a\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; package F; eval { local $^W = 0; Carp::Clan->import('.'); }; package main; eval { &A::a(1, "CrOaKiNg"); }; if ($@ =~ /\bCrOaKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bE::e\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bD::d\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bC::c\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bB::b\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\bA::a\(1,\ 'CrOaKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { &A::a(2, "CoNfEsSiNg"); }; if ($@ =~ /\bCoNfEsSiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bE::e\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bD::d\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bC::c\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bB::b\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\bA::a\(2,\ 'CoNfEsSiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(3, "CaRpInG"); }; if ($@ =~ /\bCaRpInG\ at\ .+\n .*\bF::f\((?:\d+,\s*)*3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bE::e\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bD::d\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bC::c\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bB::b\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\bA::a\(3,\ 'CaRpInG'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { local $SIG{'__WARN__'} = sub { die $_[0]; }; &A::a(4, "ClUcKiNg"); }; if ($@ =~ /\bClUcKiNg\ at\ .+\n .*\bF::f\((?:\d+,\s*)*4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bE::e\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bD::d\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bC::c\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bB::b\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\bA::a\(4,\ 'ClUcKiNg'\)\ called\ at\ .+\n .*\b(?:eval\ {\.\.\.}|require\ 0)\ called\ at\ /x) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/m008.t000644 100660 100660 00000021776 11272757315 013314 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } eval { require Bit::Vector; }; if ($@) { print "1..0\n"; exit 0; } require Date::Calendar::Year; # ====================================================================== # $year = Date::Calendar::Year->new(YEAR,PROFILE); # ($date,$rest,$sign) = $year->_move_forward_(INDEX,OFFSET,SIGN); # ====================================================================== print "1..166\n"; $n = 1; $year = Date::Calendar::Year->new(1995,{}); $full = $year->vec_full(); $yday = 0; foreach $bit (1,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0) { if ($full->bit_test($yday++) == $bit) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } $year = Date::Calendar::Year->new(1996,{}); $full = $year->vec_full(); $yday = 0; foreach $bit (0,0,0,0,0,1,1,0,0,0,0,0,1,1,0) { if ($full->bit_test($yday++) == $bit) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } $year = Date::Calendar::Year->new(1999,{}); $full = $year->vec_full(); $yday = 0; foreach $bit (0,1,1,0,0,0,0,0,1,1,0) { if ($full->bit_test($yday++) == $bit) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } ################################################## $year = Date::Calendar::Year->new(1995,{},0,1,3,5); $full = $year->vec_full(); $yday = 0; foreach $bit (0,1,0,1,0,1,0,0,1,0,1,0,1,0,0,1) { if ($full->bit_test($yday++) == $bit) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } $year = Date::Calendar::Year->new(1996,{},1,2,4); $full = $year->vec_full(); $yday = 0; foreach $bit (0,1,0,1,0,0,0,0,1,0,1,0,0,0,0) { if ($full->bit_test($yday++) == $bit) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } $year = Date::Calendar::Year->new(1999,{},2,1,2,3,4,5); $full = $year->vec_full(); $yday = 0; foreach $bit (1,0,0,1,1,1,1,1,0,0,1) { if ($full->bit_test($yday++) == $bit) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } ################################################## $year = Date::Calendar::Year->new(2000,{}); $days = $year->val_days(); $last = $days - 1; #$work = $year->vec_work(); $full = $year->vec_full(); $half = $year->vec_half(); $yday = 0; foreach $bit (1,1,0,0,0,0,0,1,1,0) { if ($full->bit_test($yday++) == $bit) {print "ok $n\n";} else {print "not ok $n\n";} $n++; } $full->Fill(); $full->Bit_Off($last); $full->Bit_Off(0); $half->Bit_On($last); $half->Bit_On(0); eval { ($date,$rest,$sign) = $year->_move_forward_(183,0.5,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2001,1,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-0.5,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [1999,12,31]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == -1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $half->Bit_Off($last); $half->Bit_Off(0); eval { ($date,$rest,$sign) = $year->_move_forward_(183,0.5,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,12,31]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0.5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-0.5,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,1,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == -0.5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(183,1.0,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2001,1,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-1.0,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [1999,12,31]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == -1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $full->Bit_On($last); $full->Bit_On(0); eval { ($date,$rest,$sign) = $year->_move_forward_(183,1.0,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2001,1,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-1.0,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [1999,12,31]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == -1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == -1) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $full->Bit_Off($last); $full->Bit_Off($last-1); $full->Bit_Off(0); $full->Bit_Off(1); $half->Bit_On($last-1); $half->Bit_On(1); eval { ($date,$rest,$sign) = $year->_move_forward_(183,0.5,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,12,31]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-0.5,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,1,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(183,1.0,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,12,31]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0.5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-1.0,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,1,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == -0.5) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; $full->Bit_Off($last-9); $full->Bit_Off(9); $half->Bit_On($last-9); $half->Bit_On(9); eval { ($date,$rest,$sign) = $year->_move_forward_(183,0.5,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,12,30]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-0.5,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,1,2]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(183,1.0,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,12,31]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,-1.0,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,1,1]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(183,0.0,+1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,12,22]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($date,$rest,$sign) = $year->_move_forward_(182,0.0,-1); }; unless ($@) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($date == [2000,1,10]) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($rest == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ($sign == 0) {print "ok $n\n";} else {print "not ok $n\n";} $n++; __END__ Date-Calc-6.3/t/f014.t000644 100660 100660 00000005056 11272757315 013273 0ustar00sbsb000000 000000 #!perl -w BEGIN { eval { require bytes; }; } use strict; no strict "vars"; BEGIN { $Date::Calc::XS_DISABLE = $Date::Calc::XS_DISABLE = 1; } use Date::Calc qw( Monday_of_Week ); # ====================================================================== # ($year,$mm,$dd) = Monday_of_Week($week,$year); # ====================================================================== print "1..16\n"; $n = 1; if ((($year,$mm,$dd) = Monday_of_Week(1,1964)) && ($year==1963)&&($mm==12)&&($dd==30)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(53,1964)) && ($year==1964)&&($mm==12)&&($dd==28)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(1,1965)) && ($year==1965)&&($mm==1)&&($dd==4)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(52,1994)) && ($year==1994)&&($mm==12)&&($dd==26)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Monday_of_Week(53,1994); }; if ($@ =~ /week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Monday_of_Week(0,1995); }; if ($@ =~ /week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(1,1995)) && ($year==1995)&&($mm==1)&&($dd==2)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(46,1995)) && ($year==1995)&&($mm==11)&&($dd==13)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(52,1995)) && ($year==1995)&&($mm==12)&&($dd==25)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Monday_of_Week(53,1995); }; if ($@ =~ /week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(1,1996)) && ($year==1996)&&($mm==1)&&($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(2,1996)) && ($year==1996)&&($mm==1)&&($dd==8)) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Monday_of_Week(0,0); }; if ($@ =~ /year out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Monday_of_Week(0,1); }; if ($@ =~ /week out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; eval { ($year,$mm,$dd) = Monday_of_Week(1,0); }; if ($@ =~ /year out of range/) {print "ok $n\n";} else {print "not ok $n\n";} $n++; if ((($year,$mm,$dd) = Monday_of_Week(1,1)) && ($year==1)&&($mm==1)&&($dd==1)) {print "ok $n\n";} else {print "not ok $n\n";} __END__ Date-Calc-6.3/lib/Date/000755 100660 100660 00000000000 11272757315 013606 5ustar00sbsb000000 000000 Date-Calc-6.3/lib/Date/Calc.pm000644 100660 100660 00000004127 11272757315 015012 0ustar00sbsb000000 000000 ############################################################################### ## ## ## Copyright (c) 1995 - 2009 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; use strict; use vars qw($XS_OK $XS_DISABLE @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); BEGIN # Re-export imports from Date::Calc::XS or Date::Calc::PP: { require Exporter; @ISA = qw(Exporter); $XS_OK = 0; unless ($XS_DISABLE and $XS_DISABLE) # prevent warning "used only once" { eval { require Date::Calc::XS; @EXPORT = (@Date::Calc::XS::EXPORT); @EXPORT_OK = (@Date::Calc::XS::EXPORT_OK); %EXPORT_TAGS = (all => [@EXPORT_OK]); Date::Calc::XS->import(@EXPORT,@EXPORT_OK); }; if ($@) { die $@ unless ($@ =~ /^Can't locate .*? at /); } else { $XS_OK = 1; } } unless ($XS_OK) { require Date::Calc::PP; @EXPORT = (@Date::Calc::PP::EXPORT); @EXPORT_OK = (@Date::Calc::PP::EXPORT_OK); %EXPORT_TAGS = (all => [@EXPORT_OK]); Date::Calc::PP->import(@EXPORT,@EXPORT_OK); } } ################################################## ## ## ## "Version()" is available but not exported ## ## in order to avoid possible name clashes. ## ## Call with "Date::Calc::Version()" instead! ## ## ## ################################################## $VERSION = '6.3'; sub Version { return $VERSION; } 1; __END__ Date-Calc-6.3/lib/Date/Calendar.pm000644 100660 100660 00000014567 11272757315 015672 0ustar00sbsb000000 000000 ############################################################################### ## ## ## Copyright (c) 2000 - 2009 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::Calendar; BEGIN { eval { require bytes; }; } use strict; use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION ); require Exporter; @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(); $VERSION = '6.3'; use Carp::Clan qw(^Date::); use Date::Calc::Object qw(:ALL); use Date::Calendar::Year qw( check_year empty_period ); sub new { my($class) = shift; my($profile) = shift; my($language) = shift || 0; my($self); $self = [ ]; $class = ref($class) || $class || 'Date::Calendar'; bless($self, $class); $self->[0] = { }; $self->[1] = $profile; $self->[2] = $language; $self->[3] = [@_]; return $self; } sub year { my($self) = shift; my($year) = shift_year(\@_); &check_year($year); if (defined $self->[0]{$year}) { return $self->[0]{$year}; } else { return $self->[0]{$year} = Date::Calendar::Year->new( $year, $self->[1], $self->[2], @{$self->[3]} ); } } sub cache_keys { my($self) = shift; return( sort {$a<=>$b} keys(%{$self->[0]}) ); } sub cache_vals { my($self) = shift; local($_); return( map $self->[0]{$_}, sort {$a<=>$b} keys(%{$self->[0]}) ); } sub cache_clr { my($self) = shift; $self->[0] = { }; } sub cache_add { my($self) = shift; my($year); while (@_) { $year = shift_year(\@_); $self->year($year); } } sub cache_del { my($self) = shift; my($year); while (@_) { $year = shift_year(\@_); if (exists $self->[0]{$year}) { delete $self->[0]{$year}; } } } sub date2index { my($self) = shift; my(@date) = shift_date(\@_); return $self->year($date[0])->date2index(@date); } sub labels { my($self) = shift; my($year); my(@date); my(%result); if (@_) { @date = shift_date(\@_); return $self->year($date[0])->labels(@date); } else { local($_); %result = (); foreach $year (keys(%{$self->[0]})) { grep( $result{$_} = 0, $self->year($year)->labels() ); } return wantarray ? (keys %result) : scalar(keys %result); } } sub search { my($self,$pattern) = @_; my($year); my(@result); @result = (); foreach $year (sort {$a<=>$b} keys(%{$self->[0]})) { push( @result, $self->year($year)->search($pattern) ); } return wantarray ? (@result) : scalar(@result); } sub tags { my($self) = shift; my(%result) = (); my(@date); if (@_) { @date = shift_date(\@_); return $self->year($date[0])->tags(@date); } else { return \%result; } } sub delta_workdays { my($self) = shift; my($yy1,$mm1,$dd1) = shift_date(\@_); my($yy2,$mm2,$dd2) = shift_date(\@_); my($including1,$including2) = (shift,shift); my($days,$empty,$year); $days = 0; $empty = 1; if ($yy1 == $yy2) { return $self->year($yy1)->delta_workdays( $yy1,$mm1,$dd1, $yy2,$mm2,$dd2, $including1,$including2); } elsif ($yy1 < $yy2) { unless (($mm1 == 12) && ($dd1 == 31) && (!$including1)) { $days += $self->year($yy1)->delta_workdays( $yy1,$mm1,$dd1, $yy1,12,31, $including1,1); $empty = 0; } unless (($mm2 == 1) && ($dd2 == 1) && (!$including2)) { $days += $self->year($yy2)->delta_workdays( $yy2, 1, 1, $yy2,$mm2,$dd2, 1,$including2); $empty = 0; } for ( $year = $yy1 + 1; $year < $yy2; $year++ ) { $days += $self->year($year)->delta_workdays( $year,1,1, $year,12,31, 1,1); $empty = 0; } } else { unless (($mm2 == 12) && ($dd2 == 31) && (!$including2)) { $days -= $self->year($yy2)->delta_workdays( $yy2,$mm2,$dd2, $yy2,12,31, $including2,1); $empty = 0; } unless (($mm1 == 1) && ($dd1 == 1) && (!$including1)) { $days -= $self->year($yy1)->delta_workdays( $yy1, 1, 1, $yy1,$mm1,$dd1, 1,$including1); $empty = 0; } for ( $year = $yy2 + 1; $year < $yy1; $year++ ) { $days -= $self->year($year)->delta_workdays( $year,1,1, $year,12,31, 1,1); $empty = 0; } } &empty_period() if ($empty); return $days; } sub add_delta_workdays { my($self) = shift; my($yy,$mm,$dd) = shift_date(\@_); my($days) = shift; my($date,$rest,$sign); if ($days == 0) { $rest = $self->year($yy)->date2index($yy,$mm,$dd); # check date $date = Date::Calc->new($yy,$mm,$dd); return wantarray ? ($date,$days) : $date; } else { $sign = ($days > 0) ? +1 : -1; ($date,$rest,$sign) = $self->year($yy)->add_delta_workdays($yy,$mm,$dd,$days,$sign); while ($sign) { ($date,$rest,$sign) = $self->year($date)->add_delta_workdays($date,$rest,$sign); } return wantarray ? ($date,$rest) : $date; } } sub is_full { my($self) = shift; my(@date) = shift_date(\@_); my($year) = $self->year($date[0]); return $year->vec_full->bit_test( $year->date2index(@date) ); } sub is_half { my($self) = shift; my(@date) = shift_date(\@_); my($year) = $self->year($date[0]); return $year->vec_half->bit_test( $year->date2index(@date) ); } sub is_work { my($self) = shift; my(@date) = shift_date(\@_); my($year) = $self->year($date[0]); return $year->vec_work->bit_test( $year->date2index(@date) ); } 1; __END__ Date-Calc-6.3/lib/Date/Calc.pod000644 100660 100660 00000325560 11272757315 015167 0ustar00sbsb000000 000000 =head1 NAME Date::Calc - Gregorian calendar date calculations =head1 MOTTO Keep it small, fast and simple =head1 PREFACE This package consists of a C library and a Perl module (which uses the C library, internally) for all kinds of date calculations based on the Gregorian calendar (the one used in all western countries today), thereby complying with all relevant norms and standards: S, S and, to some extent, S (where applicable). (See also http://www.engelschall.com/u/sb/download/Date-Calc/DIN1355/ for a scan of part of the "S" document (in German)). The module of course handles year numbers of 2000 and above correctly ("Year 2000" or "Y2K" compliance) -- actually all year numbers from 1 to the largest positive integer representable on your system (which is at least 32767) can be dealt with. This is not true, however, for the import/export functions in this package which are an interface to the internal POSIX date and time functions of your system, which can only cover dates in the following ranges: 01-Jan-1970 00:00:00 GMT .. 19-Jan-2038 03:14:07 GMT [Unix etc.] 01-Jan-1904 00:00:00 LT .. 06-Feb-2040 06:28:15 LT [MacOS Classic] (LT = local time) Note that this package projects the Gregorian calendar back until the year S<1 A.D.> -- even though the Gregorian calendar was only adopted in 1582, mostly by the Catholic European countries, in obedience to the corresponding decree of Pope S in that year. Some (mainly protestant) countries continued to use the Julian calendar (used until then) until as late as the beginning of the 20th century. Finally, note that this package is not intended to do everything you could ever imagine automagically for you; it is rather intended to serve as a toolbox (in the best of UNIX spirit and traditions) which should, however, always get you where you want to go. See the section "RECIPES" at the bottom of this document for solutions to common problems! If nevertheless you can't figure out how to solve a particular problem, please let me know! (See e-mail address at the end of this document.) =head1 SYNOPSIS use Date::Calc 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 ); use Date::Calc qw(:all); Days_in_Year $days = Days_in_Year($year,$month); Days_in_Month $days = Days_in_Month($year,$month); Weeks_in_Year $weeks = Weeks_in_Year($year); leap_year if (leap_year($year)) check_date if (check_date($year,$month,$day)) check_time if (check_time($hour,$min,$sec)) check_business_date if (check_business_date($year,$week,$dow)) Day_of_Year $doy = Day_of_Year($year,$month,$day); Date_to_Days $days = Date_to_Days($year,$month,$day); Day_of_Week $dow = Day_of_Week($year,$month,$day); Week_Number $week = Week_Number($year,$month,$day); # DEPRECATED Week_of_Year ($week,$year) = Week_of_Year($year,$month,$day); # RECOMMENDED $week = Week_of_Year($year,$month,$day); # DANGEROUS Monday_of_Week ($year,$month,$day) = Monday_of_Week($week,$year); Nth_Weekday_of_Month_Year if (($year,$month,$day) = Nth_Weekday_of_Month_Year($year,$month,$dow,$n)) Standard_to_Business ($year,$week,$dow) = Standard_to_Business($year,$month,$day); Business_to_Standard ($year,$month,$day) = Business_to_Standard($year,$week,$dow); Delta_Days $Dd = Delta_Days($year1,$month1,$day1, $year2,$month2,$day2); Delta_DHMS ($Dd,$Dh,$Dm,$Ds) = Delta_DHMS($year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2); Delta_YMD ($Dy,$Dm,$Dd) = Delta_YMD($year1,$month1,$day1, $year2,$month2,$day2); Delta_YMDHMS ($D_y,$D_m,$D_d, $Dh,$Dm,$Ds) = Delta_YMDHMS($year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2); N_Delta_YMD ($Dy,$Dm,$Dd) = N_Delta_YMD($year1,$month1,$day1, $year2,$month2,$day2); N_Delta_YMDHMS ($D_y,$D_m,$D_d, $Dhh,$Dmm,$Dss) = N_Delta_YMDHMS($year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2); Normalize_DHMS ($Dd,$Dh,$Dm,$Ds) = Normalize_DHMS($Dd,$Dh,$Dm,$Ds); Add_Delta_Days ($year,$month,$day) = Add_Delta_Days($year,$month,$day, $Dd); Add_Delta_DHMS ($year,$month,$day, $hour,$min,$sec) = Add_Delta_DHMS($year,$month,$day, $hour,$min,$sec, $Dd,$Dh,$Dm,$Ds); Add_Delta_YM ($year,$month,$day) = Add_Delta_YM($year,$month,$day, $Dy,$Dm); Add_Delta_YMD ($year,$month,$day) = Add_Delta_YMD($year,$month,$day, $Dy,$Dm,$Dd); Add_Delta_YMDHMS ($year,$month,$day, $hour,$min,$sec) = Add_Delta_YMDHMS($year,$month,$day, $hour,$min,$sec, $D_y,$D_m,$D_d, $Dh,$Dm,$Ds); Add_N_Delta_YMD ($year,$month,$day) = Add_N_Delta_YMD($year,$month,$day, $Dy,$Dm,$Dd); Add_N_Delta_YMDHMS ($year,$month,$day, $hour,$min,$sec) = Add_N_Delta_YMDHMS($year,$month,$day, $hour,$min,$sec, $D_y,$D_m,$D_d, $Dhh,$Dmm,$Dss); System_Clock ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = System_Clock([$gmt]); Today ($year,$month,$day) = Today([$gmt]); Now ($hour,$min,$sec) = Now([$gmt]); Today_and_Now ($year,$month,$day, $hour,$min,$sec) = Today_and_Now([$gmt]); This_Year $year = This_Year([$gmt]); Gmtime ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Gmtime([time]); Localtime ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Localtime([time]); Mktime $time = Mktime($year,$month,$day, $hour,$min,$sec); Timezone ($D_y,$D_m,$D_d, $Dh,$Dm,$Ds, $dst) = Timezone([time]); Date_to_Time $time = Date_to_Time($year,$month,$day, $hour,$min,$sec); Time_to_Date ($year,$month,$day, $hour,$min,$sec) = Time_to_Date([time]); Easter_Sunday ($year,$month,$day) = Easter_Sunday($year); Decode_Month if ($month = Decode_Month($string[,$lang])) Decode_Day_of_Week if ($dow = Decode_Day_of_Week($string[,$lang])) Decode_Language if ($lang = Decode_Language($string)) Decode_Date_EU if (($year,$month,$day) = Decode_Date_EU($string[,$lang])) Decode_Date_US if (($year,$month,$day) = Decode_Date_US($string[,$lang])) Fixed_Window $year = Fixed_Window($yy); Moving_Window $year = Moving_Window($yy); Compress $date = Compress($year,$month,$day); Uncompress if (($century,$year,$month,$day) = Uncompress($date)) check_compressed if (check_compressed($date)) Compressed_to_Text $string = Compressed_to_Text($date[,$lang]); Date_to_Text $string = Date_to_Text($year,$month,$day[,$lang]); Date_to_Text_Long $string = Date_to_Text_Long($year,$month,$day[,$lang]); English_Ordinal $string = English_Ordinal($number); Calendar $string = Calendar($year,$month[,$orthodox[,$lang]]); Month_to_Text $string = Month_to_Text($month[,$lang]); Day_of_Week_to_Text $string = Day_of_Week_to_Text($dow[,$lang]); Day_of_Week_Abbreviation $string = Day_of_Week_Abbreviation($dow[,$lang]); Language_to_Text $string = Language_to_Text($lang); Language $lang = Language(); Language($lang); # DEPRECATED $oldlang = Language($newlang); # DEPRECATED Languages $max_lang = Languages(); Decode_Date_EU2 if (($year,$month,$day) = Decode_Date_EU2($string[,$lang])) Decode_Date_US2 if (($year,$month,$day) = Decode_Date_US2($string[,$lang])) Parse_Date if (($year,$month,$day) = Parse_Date($string[,$lang])) ISO_LC $lower = ISO_LC($string); ISO_UC $upper = ISO_UC($string); Version $string = Date::Calc::Version(); =head1 IMPORTANT NOTES (See the section "RECIPES" at the bottom of this document for solutions to common problems!) =over 2 =item * "Year 2000" ("Y2K") compliance The upper limit for any year number in this module is only given by the size of the largest positive integer that can be represented in a variable of the C type "int" on your system, which is at least 32767, according to the ANSI C standard (exceptions see below). In order to simplify calculations, this module projects the gregorian calendar back until the year S<1 A.D.> -- i.e., back B the year 1582 when this calendar was first decreed by the Catholic Pope S! Therefore, B, for instance, and B, because this will in fact perform a calculation based on the year "98" A.D. and B "1998"! An exception from this rule are the functions which contain the word "compress" in their names (which can only handle years between 1970 and 2069 and also accept the abbreviations "00" to "99"), and the functions whose names begin with "Decode_Date_" (which translate year numbers below 100 using a technique known as "moving window"). If you want to convert a two-digit year number into a full-fledged, four-digit (at least for some years to come C<;-)>) year number, use the two functions "Fixed_Window()" and "Moving_Window()" (see their description further below). Note also that the following import/export functions (which are interfaces to the POSIX functions "time()", "gmtime()", "localtime()" and "mktime()" or (the last two) substitutes for the BSD function "timegm()" and the POSIX function "gmtime()") have a very limited range of representable dates (in contrast to all other functions in this package, which cover virtually any date including and after S): System_Clock() Today() Now() Today_and_Now() This_Year() Gmtime() Localtime() Mktime() Timezone() Date_to_Time() Time_to_Date() These functions can only deal with dates in the range from S<01-Jan-1970 00:00:00 GMT> to S<19-Jan-2038 03:14:07 GMT> (the latter limit is only authoritative on S<32 bit> systems, however, and can (in principle, through a few code changes) be extended somewhat C<:-)> on S<64 bit> systems). On MacOS Classic, the valid range of dates is between (both included) S<01-Jan-1904 00:00:00> (local time) to S<06-Feb-2040 06:28:15> (local time). Note further that the function "Easter_Sunday()" can only be used for years in the range 1583 to 2299. =item * POSIX functions Note that the following functions Gmtime() Localtime() Mktime() Timezone() are actually wrappers around or based upon the corresponding POSIX functions "time()", "gmtime()", "localtime()" and "mktime()". As such, they depend on local settings of the underlying machine such as e.g. the system clock, the time zone and the locale. Their results can therefore sometimes be unexpected or counter-intuitive. Therefore, no support can be provided for these functions. They are supplied "as is", purely for the sake of interoperability. Use at your own risk. (You have been warned!) =item * First index B ranges in this module start with "C<1>", B "C<0>"! I.e., the day of month, day of week, day of year, month of year, week of year, first valid year number and language B start counting at one, B zero! The only exception is the function "C", which may in fact return "C<0>" when the given date actually lies in the last week of the B year, and of course the numbers for hours (C<0..23>), minutes (C<0..59>) and seconds (C<0..59>). =item * Function naming conventions Function names completely in lower case indicate a boolean return value. =item * Boolean values Boolean values returned from functions in this module are always a numeric zero ("C<0>") for "false" and a numeric one ("C<1>") for "true". =item * Exception handling The functions in this module will usually die with a corresponding error message if their input parameters, intermediate results or output values are out of range. The following functions handle errors differently: - check_date() - check_time() - check_business_date() - check_compressed() (which return a "false" return value when the given input does not represent a valid date or time), - Nth_Weekday_of_Month_Year() (which returns an empty list if the requested 5th day of week does not exist), - Decode_Month() - Decode_Day_of_Week() - Decode_Language() - Fixed_Window() - Moving_Window() - Compress() (which return "C<0>" upon failure or invalid input), and - Decode_Date_EU() - Decode_Date_US() - Decode_Date_EU2() - Decode_Date_US2() - Parse_Date() - Uncompress() (which return an empty list upon failure or invalid input). Note that you can always catch an exception thrown by any of the functions in this module and handle it yourself by enclosing the function call in an "C" with curly brackets and checking the special variable "C<$@>" (see L for details). =back =head1 DESCRIPTION =over 2 =item * C =item * C You can either specify the functions you want to import explicitly by enumerating them between the parentheses of the "C" operator, or you can use the "C<:all>" tag instead to import B available functions. =item * C<$days = Days_in_Year($year,$month);> This function returns the sum of the number of days in the months starting with January up to and including "C<$month>" in the given year "C<$year>". I.e., "C" returns "C<31>", "C" returns "C<59>", "C" returns "C<90>", and so on. Note that "C" returns the number of days in the given year "C<$year>", i.e., either "C<365>" or "C<366>". =item * C<$days = Days_in_Month($year,$month);> This function returns the number of days in the given month "C<$month>" of the given year "C<$year>". The year must always be supplied, even though it is only needed when the month is February, in order to determine whether it is a leap year or not. I.e., "C" returns "C<31>", "C" returns "C<28>", "C" returns "C<29>", "C" returns "C<31>", and so on. =item * C<$weeks = Weeks_in_Year($year);> This function returns the number of weeks in the given year "C<$year>", i.e., either "C<52>" or "C<53>". =item * C This function returns "true" ("C<1>") if the given year "C<$year>" is a leap year and "false" ("C<0>") otherwise. =item * C This function returns "true" ("C<1>") if the given three numerical values "C<$year>", "C<$month>" and "C<$day>" constitute a valid date, and "false" ("C<0>") otherwise. =item * C This function returns "true" ("C<1>") if the given three numerical values "C<$hour>", "C<$min>" and "C<$sec>" constitute a valid time (C<0 E= $hour E 24>, C<0 E= $min E 60> and C<0 E= $sec E 60>), and "false" ("C<0>") otherwise. =item * C This function returns "true" ("C<1>") if the given three numerical values "C<$year>", "C<$week>" and "C<$dow>" constitute a valid date in business format, and "false" ("C<0>") otherwise. B that this function does B compute whether a given date is a business day (i.e., Monday to Friday)! To do so, use "C<(Day_of_Week($year,$month,$day) E 6)>" instead. =item * C<$doy = Day_of_Year($year,$month,$day);> This function returns the (relative) number of the day of the given date in the given year. E.g., "C" returns "C<1>", "C" returns "C<32>", and "C" returns either "C<365>" or "C<366>". The day of year is sometimes also referred to as the Julian day (or date), although it has nothing to do with the Julian calendar, the calendar which was used before the Gregorian calendar. In order to convert the number returned by this function back into a date, use the function "C" (described further below), as follows: $doy = Day_of_Year($year,$month,$day); ($year,$month,$day) = Add_Delta_Days($year,1,1, $doy - 1); =item * C<$days = Date_to_Days($year,$month,$day);> This function returns the (absolute) number of the day of the given date, where counting starts at the 1st of January of the year S<1 A.D.> I.e., "C" returns "C<1>", "C" returns "C<365>", "C" returns "C<366>", "C" returns "C<729510>", and so on. This is sometimes also referred to (not quite correctly) as the Julian date (or day). This may cause confusion, because also the number of the day in a year (from 1 to 365 or 366) is frequently called the "Julian day". More confusing still, this has nothing to do with the Julian calendar, which was used B the Gregorian calendar. The Julian calendar was named after famous Julius Caesar, who had instituted it in Roman times. The Julian calendar is less precise than the Gregorian calendar because it has too many leap years compared to the true mean length of a year (but the Gregorian calendar also still has one day too much every 5000 years). Anyway, the Julian calendar was better than what existed before, because rulers had often changed the calendar used until then in arbitrary ways, in order to lengthen their own reign, for instance. In order to convert the number returned by this function back into a date, use the function "C" (described further below), as follows: $days = Date_to_Days($year,$month,$day); ($year,$month,$day) = Add_Delta_Days(1,1,1, $days - 1); =item * C<$dow = Day_of_Week($year,$month,$day);> This function returns the number of the day of week of the given date. The function returns "C<1>" for Monday, "C<2>" for Tuesday and so on until "C<7>" for Sunday. Note that in the Hebrew calendar (on which the Christian calendar is based), the week starts with Sunday and ends with the Sabbath or Saturday (where according to the Genesis (as described in the Bible) the Lord rested from creating the world). In medieval times, Catholic Popes have decreed the Sunday to be the official day of rest, in order to dissociate the Christian from the Hebrew belief. It appears that this actually happened with the Emperor Constantin, who converted to Christianity but still worshipped the Sun god and therefore moved the Christian sabbath to the day of the Sun. Nowadays, the Sunday B the Saturday are commonly considered (and used as) days of rest, usually referred to as the "week-end". Consistent with this practice, current norms and standards (such as S, S and S) define the Monday as the first day of the week. =item * C<$week = Week_Number($year,$month,$day);> This function returns the number of the week the given date lies in. If the given date lies in the B week of the B year, "C<0>" is returned. If the given date lies in the B week of the B year, "C" is returned. =item * C<($week,$year) = Week_of_Year($year,$month,$day);> This function returns the number of the week the given date lies in, as well as the year that week belongs to. I.e., if the given date lies in the B week of the B year, "C<(Weeks_in_Year($year-1), $year-1)>" is returned. If the given date lies in the B week of the B year, "C<(1, $year+1)>" is returned. Otherwise, "C<(Week_Number($year,$month,$day), $year)>" is returned. =item * C<$week = Week_of_Year($year,$month,$day);> In scalar context, this function returns just the week number. This allows you to write "C<$week = Week_of_Year($year,$month,$day);>" instead of "C<($week) = Week_of_Year($year,$month,$day);>" (note the parentheses around "C<$week>"). If the given date lies in the B week of the B year, "C" is returned. If the given date lies in the B week of the B year, "C<1>" is returned. Otherwise the return value is identical with that of "C". B that using this function in scalar context is a B feature, because without knowing which year the week belongs to, you might inadvertently assume the wrong one! If for instance you are iterating through an interval of dates, you might assume that the week always belongs to the same year as the given date, which unfortunately is B in some cases! In many years, the 31st of December for instance belongs to week number one of the B year. Assuming that the year is the same as your date (31st of December, in this example), sends you back to the first week of the B year - the Monday of which, by the way, in case of bad luck, might actually lie in the year B the current year! This actually happens in 2002, for example. So you always need to provide the correct corresponding year number by other means, keeping track of it yourself. In case you do not understand this, never mind, but then simply B this function in scalar context! =item * C<($year,$month,$day) = Monday_of_Week($week,$year);> This function returns the date of the first day of the given week, i.e., the Monday. "C<$year>" must be greater than or equal to "C<1>", and "C<$week>" must lie in the range "C<1>" to "C". Note that you can write "C<($year,$month,$day) = Monday_of_Week(Week_of_Year($year,$month,$day));>" in order to calculate the date of the Monday of the same week as the given date. If you want to calculate any other day of week in the same week as a given date, use @date = Add_Delta_Days(Monday_of_Week(Week_of_Year(@date)),$offset); where C<$offset = 1> for Tuesday, C<2> for Wednesday etc. =item * C This function calculates the date of the "C<$n>"th day of week "C<$dow>" in the given month "C<$month>" and year "C<$year>"; such as, for example, the 3rd Thursday of a given month and year. This can be used to send a notification mail to the members of a group which meets regularly on every 3rd Thursday of a month, for instance. (See the section "RECIPES" near the end of this document for a code snippet to actually do so.) "C<$year>" must be greater than or equal to "C<1>", "C<$month>" must lie in the range "C<1>" to "C<12>", "C<$dow>" must lie in the range "C<1>" to "C<7>" and "C<$n>" must lie in the range "C<1>" to "C<5>", or a fatal error (with appropriate error message) occurs. The function returns an empty list when the 5th of a given day of week does not exist in the given month and year. =item * C<($year,$week,$dow) = Standard_to_Business($year,$month,$day);> This function converts a given date from standard notation (year, month, day (of month)) to business notation (year, week, day of week). =item * C<($year,$month,$day) = Business_to_Standard($year,$week,$dow);> This function converts a given date from business notation (year, week, day of week) to standard notation (year, month, day (of month)). =item * C<$Dd = Delta_Days($year1,$month1,$day1, $year2,$month2,$day2);> This function returns the difference in days between the two given dates. The result is positive if the two dates are in chronological order, i.e., if date #1 comes chronologically B date #2, and negative if the order of the two dates is reversed. The result is zero if the two dates are identical. =item * C<($Dd,$Dh,$Dm,$Ds) = Delta_DHMS($year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2);> This function returns the difference in days, hours, minutes and seconds between the two given dates with times. All four return values will be positive if the two dates are in chronological order, i.e., if date #1 comes chronologically B date #2, and negative (in all four return values!) if the order of the two dates is reversed. This is so that the two functions "C" and "C" (description see further below) are complementary, i.e., mutually inverse: Add_Delta_DHMS(@date1,@time1, Delta_DHMS(@date1,@time1, @date2,@time2)) yields "C<(@date2,@time2)>" again, whereas Add_Delta_DHMS(@date2,@time2, map(-$_, Delta_DHMS(@date1,@time1, @date2,@time2))) yields "C<(@date1,@time1)>", and Delta_DHMS(@date1,@time1, Add_Delta_DHMS(@date1,@time1, @delta)) yields "C<@delta>" again. The result is zero (in all four return values) if the two dates and times are identical. =item * C<($Dy,$Dm,$Dd) = Delta_YMD($year1,$month1,$day1, $year2,$month2,$day2);> This function returns the vector ( $year2 - $year1, $month2 - $month1, $day2 - $day1 ) This is called the "one-by-one" semantics. Adding the result of this function to the first date always yields the second date again, and adding the negative result (where the signs of all elements of the result vector have been flipped) to the second date gives the first date. See also the description of the function "Add_Delta_YMD()" further below. Example: (6,2,-30) == Delta_YMD(1996,1,31, 2002,3,1]); [1996,1,31] + ( 6, 2,-30) = [2002,3, 1] [2002,3, 1] + (-6,-2, 30) = [1996,1,31] An error occurs if any of the two given dates is invalid. =item * C<($D_y,$D_m,$D_d, $Dh,$Dm,$Ds) = Delta_YMDHMS($year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2);> This function is based on the function "Delta_YMD()" above but additionally calculates the time difference. When a carry over from the time difference occurs, the value of "C<$D_d>" is adjusted accordingly, thus giving the correct total date/time difference. Arguments are expected to be in chronological order to yield a (usually) positive result. In any case, adding the result of this function to the first date/time value (C<$year1,$month1,$day1,> C<$hour1,$min1,$sec1>) always gives the second date/time value (C<$year2,$month2,$day2,> C<$hour2,$min2,$sec2>) again, and adding the negative result (with the signs of all elements of the result vector flipped) to the second date/time value gives the first date/time value. See the function "Add_Delta_YMDHMS()" further below for adding a date/time value and a date/time difference. An error occurs if any of the given two date/time values is invalid. =item * C<($Dy,$Dm,$Dd) = N_Delta_YMD($year1,$month1,$day1, $year2,$month2,$day2);> This function returns the difference between the two given dates in a more intuitive way (as far as possible - more on that see a bit further below) than the function "Delta_YMD()" described above. The "N" which precedes its name is meant to signify "new" or "normalized". This function is loosely based on recipe #17 b) (see the section "RECIPES" below near the end of this document). However, the code of recipe #17 b) actually does not treat positive and negative values symmetrically and consistently. This new routine does. The return values of this function are guaranteed to all have the same sign (or to be zero). This is why this function is called "normalized". Moreover, the results are guaranteed to be "minimal", in the sense that C<|$Dm| E 12> and C<|$Dd| E 31> (which is equivalent to C<$Dm> lying in the range C<[-11..+11]> and C<$Dd> lying in the range C<[-30..+30]>). When the results are applied (i.e., added) to the first given date in a left-to-right order, the second given date is guaranteed to be obtained, provided that intermediary results are truncated, as done by the function "Add_Delta_YM()" (see further below), i.e., that invalid intermediate dates such as e.g. [2009,2,31] will automatically be transformed into [2009,2,28] (and not "wrapped" into the next month, e.g. to [2009,3,3]). This is called the "left-to-right with truncation" semantics. Note that reversing the order of the given dates and reversing the sign of each of the result values will not always add up. Consider the dates [2008,2,29] and [2009,2,1]: their difference is (0,11,3) ([2008,2,29] plus 11 months is [2009,1,29], which plus 3 days is [2009,2,1]), but the difference between [2009,2,1] and [2008,2,29] is (0,-11,-1), and not (0,-11,-3) ([2009,2,1] minus 11 months is [2008,3,1], which minus one day is [2008,2,29]). Another example: The difference between [1996,2,29] and [1997,2,28] is (1,0,0) (observe the truncation of the invalid date [1997,2,29] to [1997,2,28] here!), whereas the difference between [1997,2,28] and [1996,2,29] is (0,-11,-28) ([1997,2,28] minus 11 months is [1996,3,28], which minus 28 days is not [1996,3,0] but of course [1996,2,29]). "Benign" examples such as for instance the difference between [1964,1,3] and [2009,9,10] are completely symmetrical: The difference in this example is (45,8,7), whereas the difference between [2009,9,10] and [1964,1,3] is (-45,-8,-7), as would normally be expected. In this example, the result is also the same as the one returned by "Delta_YMD()". All these counter-intuitive effects are due to the fact that months (and due to leap years, also years) do not correspond to a fixed number of days, so the semantics of "plus one month" or "plus one year" are in fact undefined. The present function is an attempt to provide a definition which is intuitive most of the time, and at least consistent the rest of the time. Other definitions are of course possible, but most often lead to contradictions (e.g., the results and the given first date do not add up to the second given date). See the file "datecalc.pl" in the "examples" subdirectory of this distribution for a way to play around with this function, or go to http://www.engelschall.com/u/sb/datecalc/ for the online version. An error occurs if any of the two given dates is invalid, or if any intermediate result leads to an invalid date (this does not apply to truncation, however, as explained above). =item * C<($D_y,$D_m,$D_d, $Dhh,$Dmm,$Dss) = N_Delta_YMDHMS($year1,$month1,$day1, $hour1,$min1,$sec1, $year2,$month2,$day2, $hour2,$min2,$sec2);> This function essentially does the same as the function "N_Delta_YMD()" described immediately above, except that also the difference in hours, minutes and seconds is taken into account. This function is loosely based on recipe #17 a) (see the section "RECIPES" below near the end of this document). However, the code of recipe #17 a) actually does not treat positive and negative values symmetrically and consistently. This new routine does. The return values of this function (including the time differences) are guaranteed to all have the same sign (or to be zero). This is the reason for the "N" that precedes the name of this function, which is intended to mean "normalized" (or "new"). Moreover, the results are guaranteed to be "minimal", in the sense that C<|$D_m| E 12>, C<|$D_d| E 31>, C<|$Dhh| E 24>, C<|$Dmm| E 60> and C<|$Dss| E 60> (which is equivalent to C<$D_m> lying in the range C<[-11..+11]>, C<$D_d> lying in the range C<[-30..+30]>, C<$Dhh> lying in the range C<[-23..+23]>, and C<$Dmm> and C<$Dss> both lying in the range C<[-59..+59]>). =item * C<($Dd,$Dh,$Dm,$Ds) = Normalize_DHMS($Dd,$Dh,$Dm,$Ds);> This function takes four arbitrary values for days, hours, minutes and seconds (which may have different signs) and renormalizes them so that the values for hours, minutes and seconds will lie in the ranges C<[-23..23]>, C<[-59..59]> and C<[-59..59]>, respectively, and so that all four values have the same sign (or are zero). The given values are left untouched, i.e., unchanged. =item * C<($year,$month,$day) = Add_Delta_Days($year,$month,$day, $Dd);> This function has two principal uses: First, it can be used to calculate a new date, given an initial date and an offset (which may be positive or negative) in days, in order to answer questions like "today plus 90 days -- which date gives that?". (In order to add a weeks offset, simply multiply the weeks offset with "C<7>" and use that as your days offset.) Second, it can be used to convert the canonical representation of a date, i.e., the number of that day (where counting starts at the 1st of January in S<1 A.D.>), back into a date given as year, month and day. Because counting starts at "C<1>", you will actually have to subtract "C<1>" from the canonical date in order to get back the original date: $canonical = Date_to_Days($year,$month,$day); ($year,$month,$day) = Add_Delta_Days(1,1,1, $canonical - 1); Moreover, this function is the inverse of the function "C": Add_Delta_Days(@date1, Delta_Days(@date1, @date2)) yields "C<@date2>" again, whereas Add_Delta_Days(@date2, -Delta_Days(@date1, @date2)) yields "C<@date1>", and Delta_Days(@date1, Add_Delta_Days(@date1, $delta)) yields "C<$delta>" again. =item * C<($year,$month,$day, $hour,$min,$sec) = Add_Delta_DHMS($year,$month,$day, $hour,$min,$sec, $Dd,$Dh,$Dm,$Ds);> This function serves to add a days, hours, minutes and seconds offset to a given date and time, in order to answer questions like "today and now plus 7 days but minus 5 hours and then plus 30 minutes, what date and time gives that?": ($y,$m,$d,$H,$M,$S) = Add_Delta_DHMS(Today_and_Now(), +7,-5,+30,0); =item * C<($year,$month,$day) = Add_Delta_YM($year,$month,$day, $Dy,$Dm);> This function can be used to add a year and/or month offset to a given date. In contrast to the function described immediately below ("C"), this function does no "wrapping" into the next month if the day happens to lie outside the valid range for the resulting year and month (after adding the year and month offsets). Instead, it simply truncates the day to the last possible day of the resulting month. Examples: Adding an offset of 0 years, 1 month to the date [1999,1,31] would result in the (invalid) date [1999,2,31]. The function replaces this result by the (valid) date [1999,2,28]. Adding an offset of 1 year, 1 month to the same date [1999,1,31] as above would result in the (still invalid) date [2000,2,31]. The function replaces this result by the valid date [2000,2,29] (because 2000 is a leap year). Note that the year and month offsets can be negative, and that they can have different signs. If you want to additionally add a days offset, use the function "C" before or after calling "C": @date2 = Add_Delta_Days( Add_Delta_YM(@date1, $Dy,$Dm), $Dd ); @date2 = Add_Delta_YM( Add_Delta_Days(@date1, $Dd), $Dy,$Dm ); Note that your result may depend on the order in which you call these two functions! Consider the date [1999,2,28] and the offsets 0 years, 1 month and 1 day: [1999,2,28] plus one month is [1999,3,28], plus one day is [1999,3,29]. [1999,2,28] plus one day is [1999,3,1], plus one month is [1999,4,1]. (Which is also the reason why the "C" function does not allow to add a days offset, because this would actually require TWO functions: One for adding the days offset BEFORE and one for adding it AFTER applying the year/month offsets.) An error occurs if the initial date is not valid. Note that "C" will not, in general, return the original date "C<@date>" (consider the examples given above!). =item * C<($year,$month,$day) = Add_Delta_YMD($year,$month,$day, $Dy,$Dm,$Dd);> This function serves to add a years, months and days offset to a given date. (In order to add a weeks offset, simply multiply the weeks offset with "C<7>" and add this number to your days offset.) Note that the three offsets for years, months and days are applied independently from each other. This also allows them to have different signs. The years and months offsets are applied first, and the days offset is applied last. If the resulting date happens to fall on a day after the end of the resulting month, like the 32nd of April or the 30th of February, then the date is simply counted forward into the next month (possibly also into the next year) by the number of excessive days (e.g., the 32nd of April will become the 2nd of May). B that this behaviour differs from that of previous versions of this module! In previous versions, the day was simply truncated to the maximum number of days in the resulting month. If you want the previous behaviour, use the new function "C" (described immediately above) plus the function "C" instead. B also that because a year and a month offset is not equivalent to a fixed number of days, the transformation performed by this function is B! This is in contrast to the functions "C" and "C", which are fully and truly reversible (with the help of the functions "C" and "C", for instance). Note that for this same reason, @date = Add_Delta_YMD( Add_Delta_YMD(@date, $Dy,$Dm,$Dd), -$Dy,-$Dm,-$Dd); will in general B return the initial date "C<@date>", even though @date2 = Add_Delta_YMD( @date1, Delta_YMD(@date1, @date2) ); will always return the second date "C<@date2>", and @date1 = Add_Delta_YMD( @date2, map(-$_, Delta_YMD(@date1, @date2)) ); which is the same as @date1 = Add_Delta_YMD( @date2, Delta_YMD(@date2, @date1) ); will always return the first date "C<@date1>". Examples: [1996,1,31] + ( 6, 1,-2) = [2002,3,1] [2002,3, 1] + (-6,-1, 2) = [1996,2,3] # EXPECTED: [1996,1,31] (6,2,-30) == Delta_YMD(1996,1,31, 2002,3,1); [1996,1,31] + ( 6, 2,-30) = [2002,3, 1] [2002,3, 1] + (-6,-2, 30) = [1996,1,31] # OK (6,1,-2) == Delta_YMD(1996,2,3, 2002,3,1); [1996,2,3] + ( 6, 1,-2) = [2002,3,1] [2002,3,1] + (-6,-1, 2) = [1996,2,3] # OK Note that this is B a program bug but B so, because of the variable lengths of years and months, and hence because of the ambiguity of the difference between two dates in terms of years, months and days, i.e., the fact that the difference between two dates can be expressed in more than one way: [1996,1,31] + (6,1, -2) = [2002,3,1] [1996,1,31] + (6,2,-30) = [2002,3,1] =item * C<($year,$month,$day, $hour,$min,$sec) = Add_Delta_YMDHMS($year,$month,$day, $hour,$min,$sec, $D_y,$D_m,$D_d, $Dh,$Dm,$Ds);> Same as the function above, except that a time offset may be given in addition to the year, month and day offset. =item * C<($year,$month,$day) = Add_N_Delta_YMD($year,$month,$day, $Dy,$Dm,$Dd);> This function is actually a shortcut for applying the function "Add_Delta_YM()" first, followed by the function "Add_Delta_Days()", i.e., this function does exactly the same as ($year,$month,$day) = Add_Delta_Days( Add_Delta_YM($year,$month,$day,$Dy,$Dm), $Dd ); Beware that, if necessary, the function "Add_Delta_YM()" truncates the resulting day of the month to the largest allowable value for that month, i.e., the (invalid) result [2009,2,31] is automatically transformed into [2009,2,28]. For more details on this truncation, see the description of the function "Add_Delta_YM()" further above. This function is meant to be complementary with the function "N_Delta_YMD()" described further above. This means that it is guaranteed that the result returned by Add_N_Delta_YMD( @date1, N_Delta_YMD(@date1, @date2) ); is always identical with the given date "C<@date2>". Note however that unlike with function "Add_Delta_YMD()", the reverse is not true here, i.e., ($Dy,$Dm,$Dd) = N_Delta_YMD(@date1,@date2); @date = Add_N_Delta_YMD(@date2, -$Dy,-$Dm,-$Dd); will B always return the initial date "C<@date1>". Example: (0,11,3) == N_Delta_YMD(2008,2,29, 2009,2,1); [2008,2,29] + (0, 11, 3) = [2009,2, 1] [2009,2, 1] + (0,-11,-3) = [2008,2,27] # EXPECTED: [2008,2,29] =item * C<($year,$month,$day, $hour,$min,$sec) = Add_N_Delta_YMDHMS($year,$month,$day, $hour,$min,$sec, $D_y,$D_m,$D_d, $Dhh,$Dmm,$Dss);> This function essentially does the same as the function "Add_N_Delta_YMD()" described immediately above, except that also the difference in hours, minutes and seconds is taken into account. =item * C<($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = System_Clock([$gmt]);> If your operating system supports the corresponding system calls ("C" and "C" or "C"), this function will return the information provided by your system clock, i.e., the current date and time, the number of the day of year, the number of the day of week and a flag signaling whether daylight savings time is currently in effect or not. The ranges of values returned (and their meanings) are as follows: $year : 1970..2038 (or more) [Unix etc.] $year : 1904..2040 [MacOS Classic] $month : 1..12 $day : 1..31 $hour : 0..23 $min : 0..59 $sec : 0..59 (0..61 on some systems) $doy : 1..366 $dow : 1..7 $dst : -1..1 "C<$doy>" is the day of year, sometimes also referred to as the "julian date", which starts at "C<1>" and goes up to the number of days in that year. The day of week ("C<$dow>") will be "C<1>" for Monday, "C<2>" for Tuesday and so on until "C<7>" for Sunday. The daylight savings time flag ("C<$dst>") will be "C<-1>" if this information is not available on your system, "C<0>" for no daylight savings time (i.e., winter time) and "C<1>" when daylight savings time is in effect. If your operating system does not provide the necessary system calls, calling this function will result in a fatal "not available on this system" error message. If you want to handle this exception yourself, use "C" as follows: eval { ($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = System_Clock(); }; if ($@) { # Handle missing system clock # (For instance, ask user to enter this information manually) } Note that curlies ("{" and "}") are used here to delimit the statement to be "eval"ed (which is the way to catch exceptions in Perl), and not quotes (which is a way to evaluate Perl expressions at runtime). If the optional (boolean) input parameter "C<$gmt>" is given, a "true" value ("C<1>") will cause "C" to be used instead of "C", internally, thus returning Greenwich Mean Time (GMT, or UTC) instead of local time. =item * C<($year,$month,$day) = Today([$gmt]);> This function returns a subset of the values returned by the function "C" (see above for details), namely the current year, month and day. A fatal "not available on this system" error message will appear if the corresponding system calls are not supported by your current operating system. If the optional (boolean) input parameter "C<$gmt>" is given, a "true" value ("C<1>") will cause "C" to be used instead of "C", internally, thus returning Greenwich Mean Time (GMT, or UTC) instead of local time. =item * C<($hour,$min,$sec) = Now([$gmt]);> This function returns a subset of the values returned by the function "C" (see above for details), namely the current time (hours, minutes and full seconds). A fatal "not available on this system" error message will appear if the corresponding system calls are not supported by your current operating system. If the optional (boolean) input parameter "C<$gmt>" is given, a "true" value ("C<1>") will cause "C" to be used instead of "C", internally, thus returning Greenwich Mean Time (GMT, or UTC) instead of local time. =item * C<($year,$month,$day, $hour,$min,$sec) = Today_and_Now([$gmt]);> This function returns a subset of the values returned by the function "C" (see above for details), namely the current date (year, month, day) and time (hours, minutes and full seconds). A fatal "not available on this system" error message will appear if the corresponding system calls are not supported by your current operating system. If the optional (boolean) input parameter "C<$gmt>" is given, a "true" value ("C<1>") will cause "C" to be used instead of "C", internally, thus returning Greenwich Mean Time (GMT, or UTC) instead of local time. =item * C<$year = This_Year([$gmt]);> This function returns the current year, according to local time. A fatal "not available on this system" error message will appear if the corresponding system calls are not supported by your current operating system. If the optional (boolean) input parameter "C<$gmt>" is given, a "true" value ("C<1>") will cause "C" to be used instead of "C", internally, thus returning Greenwich Mean Time (GMT, or UTC) instead of local time. However, this will only make a difference within a few hours around New Year (unless you are on a Pacific island, where this can be almost 24 hours). =item * C<($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Gmtime([time]);> This is Date::Calc's equivalent of Perl's built-in "gmtime()" function. See also L. With the optional argument "time" (i.e., seconds since the epoch), this function will return the corresponding values for that particular time (instead of the current time when this parameter is omitted). The ranges of values returned (and their meanings) are as follows: $year : 1970..2038 (or more) [Unix etc.] $year : 1904..2040 [MacOS Classic] $month : 1..12 $day : 1..31 $hour : 0..23 $min : 0..59 $sec : 0..59 $doy : 1..366 $dow : 1..7 $dst : -1..1 "C<$doy>" is the day of year, sometimes also referred to as the "julian date", which starts at "C<1>" and goes up to the number of days in that year. The day of week ("C<$dow>") will be "C<1>" for Monday, "C<2>" for Tuesday and so on until "C<7>" for Sunday. The daylight savings time flag ("C<$dst>") will be "C<-1>" if this information is not available on your system, "C<0>" for no daylight savings time (i.e., winter time) and "C<1>" when daylight savings time is in effect. A fatal "time out of range" error will occur if the given time value is out of range C<[0..(~0EE1)]>. If the time value is omitted, the "time()" function is called instead, internally. =item * C<($year,$month,$day, $hour,$min,$sec, $doy,$dow,$dst) = Localtime([time]);> This is Date::Calc's equivalent of Perl's built-in "localtime()" function. See also L. The ranges of values returned (and their meanings) are as follows: $year : 1970..2038 (or more) [Unix etc.] $year : 1904..2040 [MacOS Classic] $month : 1..12 $day : 1..31 $hour : 0..23 $min : 0..59 $sec : 0..59 $doy : 1..366 $dow : 1..7 $dst : -1..1 "C<$doy>" is the day of year, sometimes also referred to as the "julian date", which starts at "C<1>" and goes up to the number of days in that year. The day of week ("C<$dow>") will be "C<1>" for Monday, "C<2>" for Tuesday and so on until "C<7>" for Sunday. The daylight savings time flag ("C<$dst>") will be "C<-1>" if this information is not available on your system, "C<0>" for no daylight savings time (i.e., winter time) and "C<1>" when daylight savings time is in effect. A fatal "time out of range" error will occur if the given time value is out of range C<[0..(~0EE1)]>. If the time value is omitted, the "time()" function is called instead, internally. =item * C<$time = Mktime($year,$month,$day, $hour,$min,$sec);> This function converts a date into a time value, i.e., into the number of seconds since whatever moment in time your system considers to be the "epoch". On Unix and most other systems this is the number of seconds since January 1st 1970 at midnight (GMT). On MacOS Classic this is the number of seconds since January 1st 1904 at midnight (local time). The function is similar to the "POSIX::mktime()" function (see L for more details), but in contrast to the latter, it expects dates in the usual ranges used throughout this module: The year 2001 stays year 2001, and months are numbered from 1 to 12. A fatal "date out of range" error will occur if the given date cannot be expressed in terms of seconds since the epoch (this happens for instance when the date lies before the epoch, or if it is later than S<19-Jan-2038 03:14:07 GMT> on S<32 bit> Unix systems, or later than S<06-Feb-2040 06:28:15> (local time) on a Macintosh with MacOS Classic). Just like the "POSIX::mktime()" function, this function uses the "mktime()" system call, internally. This means that the given date and time is considered to be in local time, and that the value returned by this function will depend on your machine's local settings such as the time zone, whether daylight savings time is (or was, at the time) in effect, and the system clock itself. B that "mktime()" does not always return the same time value as fed into "localtime()", when you feed the output of "localtime()" back into "mktime()", on some systems! I.e., "C" will not always return the same value as given in "C<$time>"! =item * C<($D_y,$D_m,$D_d, $Dh,$Dm,$Ds, $dst) = Timezone([time]);> This function returns the difference between "C" and "C", which is the timezone offset in effect for the current location and the given "C