From 0bd5efa0ab37599226f0507a66b4e6396f038dd5 Mon Sep 17 00:00:00 2001 From: Michael Howe Date: Sun, 9 Mar 2014 00:32:52 +0000 Subject: [PATCH] Import original source of Date-ICal 2.678 --- Changes | 747 +++++++++++++++++++++ INTERNALS | 9 + LICENSE | 377 +++++++++++ MANIFEST | 23 + META.yml | 26 + Makefile.PL | 45 ++ README | 540 ++++++++++++++++ lib/Date/ICal.pm | 1287 +++++++++++++++++++++++++++++++++++++ lib/Date/ICal/Duration.pm | 566 ++++++++++++++++ t/00load.t | 6 + t/01sanity.t | 70 ++ t/02normalize.t | 43 ++ t/03components.t | 15 + t/04epoch.t | 36 ++ t/05ical.t | 28 + t/06add.t | 210 ++++++ t/07compare.t | 50 ++ t/08offset.t | 105 +++ t/09greg.t | 90 +++ t/10subtract.t | 46 ++ t/11duration.t | 162 +++++ 21 files changed, 4481 insertions(+) create mode 100644 Changes create mode 100644 INTERNALS create mode 100644 LICENSE create mode 100644 MANIFEST create mode 100644 META.yml create mode 100644 Makefile.PL create mode 100644 README create mode 100755 lib/Date/ICal.pm create mode 100644 lib/Date/ICal/Duration.pm create mode 100644 t/00load.t create mode 100644 t/01sanity.t create mode 100644 t/02normalize.t create mode 100644 t/03components.t create mode 100644 t/04epoch.t create mode 100644 t/05ical.t create mode 100644 t/06add.t create mode 100644 t/07compare.t create mode 100644 t/08offset.t create mode 100644 t/09greg.t create mode 100644 t/10subtract.t create mode 100644 t/11duration.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..79d4cfa --- /dev/null +++ b/Changes @@ -0,0 +1,747 @@ +2011-05-10 + + * Applies patch from Mark Alway for situation where min, hour, and + sec are all '00'. However, a reminder that you should be using the + DateTime modules instead. + +2009-08-19 09:23 rbowen + + * No functional changes in this revision, just a move to svn and a + cleanup of the documentation, removing references to long-defunct + URLs, and adding references to the datetime.perl.org project, where + you really should be looking for all of your Perl datetime needs. + +2003-01-18 15:11 rbowen + + * MANIFEST (1.10): Added license to manifest + +2003-01-18 15:10 rbowen + + * LICENSE (1.1): Put LICENSE in the distribution, since we had + never made it clear what license we were distributing under. + +2003-01-18 15:09 rbowen + + * lib/Date/ICal.pm (1.72): Patch received from Martijn, to make + days_this_year run faster. + +2003-01-13 07:23 rbowen + + * lib/Date/ICal.pm (1.71), t/08offset.t (1.10): Make + _offset_(from|to)_seconds into offset_(from|to)_seconds. ie. make + them public functions, rather than hidden ones, since they are + useful from more places than just inside the module. Requested by + Martijn. + +2003-01-10 15:57 rbowen + + * Makefile.PL (1.20): Had this patch for a long time. Requires a + particular verion of prereq's for functionality that we are using. + +2002-08-31 22:46 rbowen + + * t/: 02normalize.t (1.4), 03components.t (1.3), 04epoch.t (1.3), + 05ical.t (1.2), 06add.t (1.7), 07compare.t (1.2): Change a bunch of + tests from ok() to is() in order that 'make test' will report more + useful things on failure. + +2002-08-31 22:37 rbowen + + * t/01sanity.t (1.7): Moved from ok() tests to is() tests, in order + to get more useful failure messages. + +2002-06-26 17:21 rbowen + + * lib/Date/ICal.pm (1.70): Documentation bug. new() does not in + fact accept a 'tz' argument. + +2002-02-07 06:33 rbowen + + * lib/Date/ICal/Duration.pm (1.61, Date-ICal-1_69): Bumping up the + version number on Duration.pm so that CPAN reports useful + information about what the latest version is. + +2002-02-07 06:32 rbowen + + * lib/Date/ICal.pm (1.69), t/08offset.t (1.9) (utags: + Date-ICal-1_69): Remove skip in test, and actually test the + localtime functionality. Adjust seconds the correct direction in + the ical method. + +2002-01-21 14:44 jesse + + * lib/Date/ICal.pm (1.68): Date::ICal->new bitched if you were + setting an epoch time and had even an offset of "0". That's not + useful to anyone. it now explicitly checks to make sure an offset + isn't 0 before bitching. + +2001-12-27 21:15 rbowen + + * lib/Date/ICal.pm (1.67), t/12add.t (1.1, Date-ICal-1_69): We are + now able to use + and += to add durations (either a string or a + Date::ICal::Duration object) to a Date::ICal object. Added tests + for same. + +2001-12-26 21:37 rbowen + + * t/: 09greg.t (1.2), 10subtract.t (1.5) (utags: Date-ICal-1_69): + Spacing changes (courtesy of perltidy) in the tests, so that I can + better read what is going on here. No functional change. + +2001-12-26 21:27 rbowen + + * Makefile.PL (1.19, Date-ICal-1_69): Add a vim syntax highlighting + line to the Change log file so that it looks pretty. + +2001-12-26 21:25 rbowen + + * lib/Date/ICal.pm (1.66): No longer need to do strange workaround + to subtract dates resulting in negative duration. It Just Works + (tm). + +2001-12-26 21:07 rbowen + + * lib/Date/ICal/Duration.pm (1.10), t/11duration.t (1.5, + Date-ICal-1_69): Permit the creation of Duration objects with + negative attributes. Note that all attributes have to have the same + sign. Mixed-sign attributes will result in the entire duration + being negative. This could stand to be documented more clearly. + Also, all accessors have been modified to explicitly return undef + if that attribute has zero value. I'm not sure if this is desired, + but it's the way that it is documented, and what the tests expect. + Tests added to verify all this stuff. + +2001-12-26 20:21 rbowen + + * Makefile.PL (1.18): Add the Duration documentation to the README + on make dist + +2001-12-26 20:15 rbowen + + * lib/Date/ICal/Duration.pm (1.9): Code folds. No functional + change. + +2001-12-26 15:55 rbowen + + * lib/Date/ICal.pm (1.65), t/10subtract.t (1.4): A small + work-around because D::I::Duration does not correctly handle + negative arguments yet. See diff 1.7 -> 1.8 of + Date::ICal::Duration. When D::I::Duration correctly handles + negative arguments, this patch should be mostly reversed. Added + tests for subtracting dates to get negative duration. + +2001-12-26 15:50 rbowen + + * lib/Date/ICal/Duration.pm (1.8): This is step one. Components now + return signed. And the 'sign' argument is being honored now, rather + than being discarded. Need to add tests for this stuff. Still does + not correctly handle negative arguments. + +2001-12-20 16:04 rbowen + + * lib/Date/ICal.pm (1.64), t/10subtract.t (1.3): Added the ability + to subtract durations from a date, either as a Date::ICal::Duration + object, or as a ICal duration string. Tests to match. + +2001-12-20 10:20 rbowen + + * lib/Date/ICal/Duration.pm (1.7): Documentation: The parameter is + 'ical' not 'string' to create an object with an ical duration + string. + +2001-12-19 07:52 rbowen + + * Makefile.PL (1.17), README (1.4): As suggested, generatel README + at release time, rather than having it in CVS. + +2001-12-18 21:24 rbowen + + * README (1.3), lib/Date/ICal.pm (1.63): Bring README up to date + with the POD. Minor POD fix in ICal.pm + +2001-12-18 21:21 rbowen + + * lib/Date/ICal.pm (1.62): Patch from Yitzchak. Adds day_of_week + method. Other minor POD fixes. + +2001-12-16 19:21 rbowen + + * MANIFEST (1.9, Date-ICal-1_69, Date-ICal-1_61): Added + t/11duration.t to MANIFEST + +2001-12-16 19:06 rbowen + + * Makefile.PL (1.16, Date-ICal-1_61): Added warning back in about + possibly changing API. + +2001-12-16 17:15 rbowen + + * Makefile.PL (1.15), lib/Date/ICal.pm (1.61, Date-ICal-1_61), + t/10subtract.t (1.2, Date-ICal-1_61): sub subtract in Date::ICal + now uses Date::ICal::Duration objects, rather than doing its own + math. Added tests to test this functionality, and some TODO notes + for what I would like it to do in the near future. + +2001-12-16 17:14 rbowen + + * lib/Date/ICal/Duration.pm (1.6, Date-ICal-1_61): Added sub + as_days to return the number of days without weeks %'ed out. And + some code folding foo. + +2001-12-16 16:54 coral + + * lib/Date/ICal/Duration.pm (1.5): Extracting clarity from + Duration.pm's synopsis is HARD. + +2001-12-16 16:52 rbowen + + * t/11duration.t (1.4, Date-ICal-1_61): Removes some redundant 'my' + in tests. + +2001-12-16 16:30 coral + + * lib/Date/ICal/Duration.pm (1.4): TODO: Figure out what we're + going to do with sign data. + +2001-12-16 16:12 srl + + * lib/Date/ICal/Duration.pm (1.3): Added code for accesors and + as_elements. + +2001-12-16 16:11 srl + + * t/11duration.t (1.3): Added tests for as_elements and for + accessors. Added a new sign() read-only accessor. + +2001-12-16 15:47 srl + + * lib/Date/ICal/Duration.pm (1.2): Fleshed out some more of the + methods; this is largely drawn from Net::ICal::Duration, which I + expect to be replaced by this module. + +2001-12-16 15:45 srl + + * t/11duration.t (1.2): Added more tests for Duration + functionality. + +2001-12-16 15:14 rbowen + + * Changes (1.3), Makefile.PL (1.14): Take Changes out of cvs. + Autogenerate it on make dist. + +2001-12-16 15:11 rbowen + + * MANIFEST (1.8): Add Changes to the manifest so that it gets + shipped with the dist. + +2001-12-14 21:24 rbowen + + * Changes (1.2): Updated change log to include the entire project, + using cvs2cl + +2001-12-14 00:29 rbowen + + * INTERNALS (1.2, Date-ICal-1_69, Date-ICal-1_61): Remove + inaccurate and/or outdates notes about the internals. Once the + internals stabilize, I'll write something more useful here. + +2001-12-14 00:27 rbowen + + * Changes (1.1): Starter Changes file. Jesse said something about + generating a Changes file from CVS, which is what this is. Perhaps + his is a little more pleasant looking + +2001-12-14 00:01 rbowen + + * lib/Date/ICal.pm (1.60): Primarily documentation updates. + +2001-12-14 00:01 rbowen + + * README (1.2, Date-ICal-1_61): Bring README up to date with the + module. + +2001-12-13 22:20 rbowen + + * MANIFEST (1.7), lib/Date/ICal.pm (1.59), t/06add.t (1.6, + Date-ICal-1_69, Date-ICal-1_61): Patch submitted by Yitzchak to + make add() DWIMier, to permit more reliable subtraction of dates + via the add() method, and tests to make sure that it is all doing + what it should. Also provides the eom_mode parameter to make adding + months do what you expect ALL THE TIME. All tests still pass. + Yitzchak++ + +2001-12-13 17:33 srl + + * lib/Date/ICal/Duration.pm (1.1), t/11duration.t (1.1): Added + Date::ICal::Duration trivial skeleton and basic tests. API comments + welcome; code coming soon. + +2001-12-12 21:58 rbowen + + * lib/Date/ICal.pm (1.58), t/10subtract.t (1.1): Possible + implementation of subtraction of dates. Comments welcomed. + +2001-12-12 19:25 rbowen + + * MANIFEST (1.6), Makefile.PL (1.13): ICal.pm has (finally!) moved + into lib/Date where it should have been to begin with. + +2001-12-11 10:12 rbowen + + * lib/Date/ICal.pm (1.57): I've removed some warnings, because we + are basically warning when people use documented default behavior. + This is very irritating. I also need to update the documentation so + that it is more clear on this point, but for the moment, this + scratches my immediate itch. --DrBacchus + +2001-12-08 22:30 rbowen + + * Makefile.PL (1.12): Memoize no longer a prereq + +2001-11-30 22:25 rbowen + + * lib/Date/ICal.pm (1.56): This is, I believe, the intent of + Yitzchak's first two patches. There is no content in this diff, + just style things. Ran perltidy on it to make the whole file + conform to agreed-upon style standards. And standardized the usage + of code folding characters. + +2001-11-30 12:02 rbowen + + * Makefile.PL (1.11): Need Test::More to support skip(). + +2001-11-27 21:00 rbowen + + * lib/Date/ICal.pm (1.55), t/06add.t (1.5): Able to add n years to + a date via the add method. Tests to match. + +2001-11-26 09:38 rbowen + + * MANIFEST (1.5): Most of the tests are not making it into the + distribution, because the MANIFEST never got updated. + +2001-11-24 13:57 rbowen + + * lib/Date/ICal.pm (1.54): Oops. I reversed the order of the + argument list when I added this function back in, thereby breaking + all code that was calling it. + +2001-11-24 11:25 rbowen + + * lib/Date/ICal.pm (1.53): Since _seconds_from_offset returns a + number, not a string, we only need the sign if it is negative. + Resolves some test failures that I was seeing in t/08offset.t for + negative offsets. + +2001-11-23 22:42 rbowen + + * lib/Date/ICal.pm (1.52): Resolves one of the test failures in + offset/add - when add crossed a day boundary by virtue of a + difference in seconds, it was not compenting in the day value, and + could end up with negative times. + +2001-11-23 22:15 rbowen + + * Makefile.PL (1.10): There is no longer a module called + Pod::Tests. It is now called Test::Inline. + +2001-11-23 22:11 rbowen + + * lib/Date/ICal.pm (1.51): Added back in days_this_year method + using new greg2jd method. + +2001-11-23 22:03 rbowen + + * Makefile.PL (1.9): There are no embedded tests at this time, so + this is generating bogus test failures. Uncomment if you add inline + tests back in. + +2001-11-23 21:54 rbowen + + * lib/Date/ICal.pm (1.50), t/09greg.t (1.1, Date-ICal-1_61): This + is Yitzchak's patch to give us much more efficient gregorian <-> + julian conversions, and to remove strange anomolous problems in the + 17th and 18 centuries. Note that we lose a few internal methods + here, at least one of which I'll be putting back in a minute. + +2001-11-22 05:56 srl + + * lib/Date/ICal.pm (1.49), t/08offset.t (1.8, Date-ICal-1_61): This + version incorporates a patch by Yitzchak Scott-Thoennes to adjust + the offset() API. It no longer takes integer seconds as a + parameter, because there's no programmatic way to tell the + difference between, say, +3600 (UTC+1 in seconds) and +3600 + (UTC+36, if you interpret that as an HHMM value). + + I also refactored things a bit, creating an _offset_from_seconds + method to match _offset_to_seconds; this should eliminate some + duplication. There's also new POD to clear up some confusion about + new(offset => foo) used together with offset(). + +2001-11-22 04:22 srl + + * lib/Date/ICal.pm (1.48): API-consistency patch from Yitzchak + Scott-Thoennes ; Makes the ical() method take a + hash of parameters, not a hashref, so that ical() is like the other + methods. This crept in around 1.44, and it shouldn't have. My + mistake. + +2001-11-22 04:02 srl + + * lib/Date/ICal.pm (1.47): Fixed some 5.6isms; patch contributed by + Yitzchak Scott-Thoennes . + +2001-11-15 08:25 srl + + * lib/Date/ICal.pm (1.46), t/08offset.t (1.7): Minor patches to + tests; another piece of optimization from Mike Heins. + +2001-11-15 00:32 srl + + * benchmark.pl (1.1, Date-ICal-1_69, Date-ICal-1_61), + lib/Date/ICal.pm (1.45), t/08offset.t (1.6): Added benchmark.pl to + help developers in optimizing the module. Also modified new() to + warn more clearly if the $TZ environment variable isn't set, and + not to utterly fail tests if $TZ isn't there. + +2001-11-15 00:11 srl + + * lib/Date/ICal.pm (1.44), t/08offset.t (1.5): Further patches from + Mike Heins, plus some documentation from me: - added + localtime argument to ical() for output in localtime. Added + documentation about the localtime argument. Note that + $ENV{$TZ} is now relevant to some of the module's behavior. - + removed a memoize() that wasn't providing significant speed + improvements. - minor optimization of _calc_local_offset + +2001-11-14 23:20 srl + + * lib/Date/ICal.pm (1.43): Committed another small patch by Mike + Heins, which precalculates the values returned by the months() + function so that the module is faster at runtime. + +2001-11-14 23:11 srl + + * lib/Date/ICal.pm (1.42): Another patch from Mike Heins + (mheins@minivend.com); an optimizing cheat for leapyears; uses a + precalculated table of values instead of always calculating + leapyear values. I edited Mike's patch slightly so that @leapcheat + isn't a package global. + +2001-11-14 22:58 srl + + * lib/Date/ICal.pm (1.41): Incorporated part of a patch by Mike + Heins (mheins@minivend.com); an optimization. Internal storage of + julian times is now in $self->{julian} and $self->{julsec}, instead + of using an array. This gives us slightly better speed. Also, made + some of the UTC behaviors slightly more consistent. + +2001-10-16 06:33 srl + + * lib/Date/ICal.pm (1.40), t/01sanity.t (1.6, Date-ICal-1_69, + Date-ICal-1_61), t/02normalize.t (1.3, Date-ICal-1_69, + Date-ICal-1_61), t/03components.t (1.2, Date-ICal-1_69, + Date-ICal-1_61), t/04epoch.t (1.2, Date-ICal-1_69, Date-ICal-1_61), + t/06add.t (1.4), t/08offset.t (1.4): Further fixes to the offset() + method. This code isn't as well-tested as I'd like it to be, but it + seems to do the right thing for all the tests that are there. I had + to revise many of the tests, because the API semantics have + changed. Times must now be explicitly specified with a Z in order + to be handled as UTC. + +2001-10-14 21:58 rbowen + + * MANIFEST (1.4): Rename Readme to README, per request of coral + +2001-10-14 21:56 rbowen + + * README (1.1), Readme (1.3): coral says README is prefered to + Readme, wrt CPAN. I had no opinions either way, so here it is. + +2001-10-09 22:58 srl + + * lib/Date/ICal.pm (1.39), t/08offset.t (1.3): Added some tests, + reorganized some code to prepare spaces for offset/timezone-aware + output. Added at least one test that's known to fail for purposes + of knowing when we succeed. :) + +2001-10-09 00:28 srl + + * lib/Date/ICal.pm (1.38), t/08offset.t (1.2): Started working on + code to properly handle times with offsets from GMT. added a new + _calc_local_offset method to figure out what the current machine's + UTC offset is. We need tests for this that will work in any + timezone; patches welcome. + +2001-09-30 09:19 lotr + + * lib/Date/ICal.pm (1.37): * Oops, forgot some bits when I added + month to add() * use overload for compare + +2001-09-29 07:01 lotr + + * lib/Date/ICal.pm (1.36): Add the ability to add months to a date. + Needed for Net::ICal::Recurrence + +2001-09-26 11:26 lotr + + * lib/Date/ICal.pm (1.35), t/06add.t (1.3): * fix off-by-one error + in months() and add tests for that + +2001-09-11 23:26 rbowen + + * lib/Date/ICal.pm (1.34): There's no particular reason to have + Date::ICal be 5.6 dependant. + +2001-08-25 08:20 rbowen + + * lib/Date/ICal.pm (1.33), t/06add.t (1.2): Fixed bug reported by + Chris Jones. In sub add, I was checking one attribute and using + another. Added tests for this bug, and for adding durations by + attribute. + +2001-08-09 23:27 srl + + * lib/Date/ICal.pm (1.32), t/08offset.t (1.1): Started adding + timezone support by making an offset() method and an offset + property. This still needs to be wired into the new() method and + the output methods, but we have to resolve some interface details + first. + +2001-08-06 22:41 rbowen + + * lib/Date/ICal.pm (1.31): Test::More gets angry if there are no + tests. + +2001-08-06 22:30 rbowen + + * lib/Date/ICal.pm (1.30): Moved the inline tests into t/ for the + sake of making the module more readable. Please don't let this + discorage you from writing inline tests. + +2001-08-06 22:25 rbowen + + * t/: 04epoch.t (1.1), 05ical.t (1.1, Date-ICal-1_69, + Date-ICal-1_61), 06add.t (1.1), 07compare.t (1.1, Date-ICal-1_69, + Date-ICal-1_61): Moved a lot of tests out of the module into .t + files. + +2001-08-06 15:32 rbowen + + * Makefile.PL (1.8), lib/Date/ICal.pm (1.29): Creating an object + without args was calling gmtime( $args{epoch} ). Fixed and added + tests. Also added Time::HiRes to PREREQ list. + +2001-08-06 14:45 rbowen + + * lib/Date/ICal.pm (1.28): sub epoch was referencing another sub + that has gone away. Fixed, and added tests. + +2001-08-02 00:38 srl + + * lib/Date/ICal.pm (1.27): Adjusted the add() method to return a + copy of $self instead of the return value of $self->jd(). This was + important to making the Net::ICal tests pass, but it's also the + Right Way, I think. + +2001-08-01 23:47 rbowen + + * lib/Date/ICal.pm (1.26): Handle negative durations correctly. + +2001-07-31 22:19 rbowen + + * lib/Date/ICal.pm (1.25): Two main changes here. 1) Split the + internal date/time representation into date, time integers, so that + we don't have any more roundoff error. 2) Memoized the parsetime + and parsedate methods, so that we're not doing that three times + every time we want three components, which we were doing. + +2001-07-31 22:17 rbowen + + * Makefile.PL (1.7): Added Memoize, Storable to prereq list, so + that I can memoize some functions. + +2001-07-31 07:43 rbowen + + * lib/Date/ICal.pm (1.24): Create a new D::I object using another + D::I object (or subclass) as the initial value. This allows for + immediate conversion of a date from one calendar format to another, + which was one of my main goals to start with. :-) + +2001-07-27 12:24 rbowen + + * lib/Date/ICal.pm (1.23), t/03components.t (1.1): Creating objects + from components was not working. Fixed. + +2001-07-26 14:36 rbowen + + * MANIFEST (1.3), lib/Date/ICal.pm (1.22): Removed unused internal + methods. Updated ToDo list. + +2001-07-26 14:14 rbowen + + * INTERNALS (1.1): Discussion of the internals, and the limitations + thereof. + +2001-07-26 11:49 rbowen + + * lib/Date/ICal.pm (1.21): To compare two dates, just need to + compare their mjd representation. + +2001-07-26 11:21 rbowen + + * Readme (1.2): Generated from POD + +2001-07-26 11:19 rbowen + + * MANIFEST (1.2): Added Readme + +2001-07-25 21:32 srl + + * Makefile.PL (1.6): Added a requirement for Time::Local to the + Makefile.PL. + +2001-07-25 21:04 srl + + * Makefile.PL (1.5): Did a release tag on Date-ICal-1_20, since + DrBacchus forgot to; then added a line for Date::Leapyear in the + PREREQ section of Makefile.PL. + +2001-07-25 19:31 rbowen + + * t/: 01sanity.t (1.5), 02normalize.t (1.2) (utags: + Date-ICal-1_20): Updated tests for changes to ICal. Removed some + that are no longer relevant. "fixed" some due to round-off error. + This all works, for some slightly relaxed definition of "works". + After releasing, we need to be a little more rigorous. + +2001-07-25 19:29 rbowen + + * lib/Date/ICal.pm (1.20, Date-ICal-1_20): Complete rewrite. + Internals all changed. More discussion on the mailing list. + +2001-07-23 23:21 srl + + * lib/Date/ICal.pm (1.19): Added a minor fix to Date::ICal to allow + accessors to be set to 0. + +2001-07-23 22:28 rbowen + + * Readme (1.1, Date-ICal-1_20): Readme generated from POD + +2001-07-23 21:54 srl + + * Makefile.PL (1.4, Date-ICal-1_20), lib/Date/ICal.pm (1.18) + (utags: date-ical-1_18_01): Minor spelling corrections. Also, added + a note about the future Julian rework to TODO, and a note about + failing tests in Makefile.PL. + +2001-07-08 01:17 srl + + * lib/Date/ICal.pm (1.17): Added some arithmetic-verification tests + to Date::ICal--- they all fail currently. The problems are related + to addition when the parameter is a duration string--- unit + rollover seems to be breaking, and second values seem to be + particularly off. + +2001-07-07 22:24 rbowen + + * lib/Date/ICal.pm (1.16): Should not attempt to calculate an epoch + time for dates outside of the epoch. Added tests also. + +2001-07-07 18:20 rbowen + + * Makefile.PL (1.3): Pod::Tests and Test::More are prereq's for + this module. + +2001-07-07 15:44 rbowen + + * lib/Date/ICal.pm (1.15): ICal is now the only authoritative + internal format, as far as I can tell. There are still some parts + of this that confuse me, but epoch is being recalculated from ICal + when it is requested. We need to make sure that if epoch is called + for dates outside of the epoch, that we warn. That is not being + done yet. But all tests currently pass. At least for me. There are + probably some timezone dependencies still, and I'd appreciate some + tests by folks in other timezones. However, I did not comment out + any tests in order to make it pass the tests. In fact, I added + several. + +2001-07-07 15:25 rbowen + + * t/01sanity.t (1.4, date-ical-1_18_01): It helps if you are + actually testing the right object. + +2001-07-07 00:10 srl + + * lib/Date/ICal.pm (1.7), t/01sanity.t (1.3): Adjusted some tests + in Date::ICal to use == in tests instead of eq. + + Tried to adjust some mistakes in Date::ICal's 01sanity.t so that + those tests will pass, but no luck. Dates before the epoch are + still failing. + +2001-07-06 13:05 rbowen + + * lib/Date/ICal.pm (1.6): Calling accessor methods rather than hash + keys. Certain attributes get calculated the first time you call the + method, rather than being calculated up front, in case you never + actually need it. All Pod::Tests now succeed. + +2001-07-05 22:37 srl + + * lib/Date/ICal.pm (1.5): Added a bunch of tests for some error + conditions in Date::ICal. + + In particular, we need to check out the results of the accessors, + and we need to decide whether they're supposed to return numbers + with leading zeroes. + +2001-07-03 23:33 rbowen + + * t/00load.t (1.2, Date-ICal-1_69, Date-ICal-1_61, Date-ICal-1_20, + date-ical-1_18_01): Moved to Test::More for added readability + +2001-07-03 23:33 rbowen + + * t/01sanity.t (1.2): Moved the test to Test::More. Uncommented + several failing tests, so that I have some motivation to fix the + problem. Ran perltidy. I know, it's a fetish ... + +2001-07-02 22:55 srl + + * lib/Date/ICal.pm (1.4): Committed a bunch of tests for Date::ICal + that are failing; I don't have a solution, but I wanted to share + this in hopes someone can help. + +2001-06-29 14:07 lotr + + * lib/Date/ICal.pm (1.3): _epoch_from_ical: fix to change month + and year to be in the format timegm expects in the DATE-TIME + case, just like the DATE case already had + +2001-06-27 22:22 srl + + * Makefile.PL (1.2), lib/Date/ICal.pm (1.2): Implemented the + compare() function (with tests) for Date::ICal. + + Added a section in the Makefile.PL to compile the embedded tests + into a t/ file. + + Corrected some of the podtests that were already in D::I, because + pod2test didn't like them. + +2001-06-27 20:53 rbowen + + * MANIFEST (1.1.1.1, Date-ICal-1_20, date-ical-1_18_01), + Makefile.PL (1.1.1.1), lib/Date/ICal.pm (1.1.1.1), t/00load.t + (1.1.1.1), t/01sanity.t (1.1.1.1), t/02normalize.t (1.1.1.1, + date-ical-1_18_01) (utags: Date-ICal-1_14): Moving Date::ICal to + sourceforge reefknot repository. I hope I don't regret this. + +2001-06-27 20:53 rbowen + + * MANIFEST (1.1), Makefile.PL (1.1), lib/Date/ICal.pm (1.1), + t/00load.t (1.1), t/01sanity.t (1.1), t/02normalize.t (1.1): + Initial revision + diff --git a/INTERNALS b/INTERNALS new file mode 100644 index 0000000..3a1ce3d --- /dev/null +++ b/INTERNALS @@ -0,0 +1,9 @@ +Date::ICal internals + +This file has been completely innaccurate for at least the last 20 +revisions of this module, and does nobody any good. Someday, it should +contain useful information. + +DrBacchus +drbacchus@drbacchus.com + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..691d481 --- /dev/null +++ b/LICENSE @@ -0,0 +1,377 @@ +Terms of Perl itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +---------------------------------------------------------------------------- + +The General Public License (GPL) +Version 2, June 1991 + +Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, +Cambridge, MA 02139, 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 + + +---------------------------------------------------------------------------- + +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. +- "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 ftp.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) accompany any non-standard executables with their + corresponding Standard Version executables, giving the + non-standard executables non-standard names, and clearly + documenting 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. + +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 whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +9. 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 + + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..f20dc3f --- /dev/null +++ b/MANIFEST @@ -0,0 +1,23 @@ +lib/Date/ICal.pm +lib/Date/ICal/Duration.pm + +MANIFEST +Makefile.PL +README +INTERNALS +LICENSE +Changes + +t/00load.t +t/01sanity.t +t/02normalize.t +t/03components.t +t/04epoch.t +t/05ical.t +t/06add.t +t/07compare.t +t/08offset.t +t/09greg.t +t/10subtract.t +t/11duration.t +META.yml Module meta-data (added by MakeMaker) diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..8ffe2b0 --- /dev/null +++ b/META.yml @@ -0,0 +1,26 @@ +--- #YAML:1.0 +name: Date-ICal +version: 2.678 +abstract: ~ +author: [] +license: unknown +distribution_type: module +configure_requires: + ExtUtils::MakeMaker: 0 +build_requires: + ExtUtils::MakeMaker: 0 +requires: + Date::Leapyear: 1.03 + Storable: 0 + Test::Harness: 2.25 + Test::More: 0.45 + Time::HiRes: 0 + Time::Local: 0 +no_index: + directory: + - t + - inc +generated_by: ExtUtils::MakeMaker version 6.56 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..73da58f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,45 @@ +use ExtUtils::MakeMaker; + +print qq~ +Please note that this module is long-since abandoned. While I do accept +patches, and occasionally apply them, for the most part it is +recommended that you move off of this module and use the various modules +developed by the datetime project. You can find out more about the +datetime project at http://datetime.perl.org/ + +Rich Bowen - RBOW@CPAN.ORG +~; + +WriteMakefile( + 'NAME' => 'Date::ICal', + 'VERSION_FROM' => 'lib/Date/ICal.pm', # finds $VERSION + 'PREREQ_PM' => { + Test::Harness => '2.25', + Test::More => '0.45', + # Test::Inline => 0, + Date::Leapyear => '1.03', + Time::Local => 0, + Time::HiRes => 0, + Storable => 0, + }, # e.g., Module::Name => 1.1 +); + +# Don't currently have any inline tests +# open(MANIFEST, "MANIFEST"); +# foreach my $file (grep /\.pm$/, ) { +# chomp $file; +# my($module) = $file =~ m|^(.*)\.pm$|; +# $module =~ s|/|-|g; +# system("pod2test $file t/embedded-$module.t"); +#} + +sub MY::postamble { + package MY; + "\npredist: all\n" . + "\tcvs2cl -r -b -t -f Changes\n". + "\techo '# vim: filetype=changelog' >> Changes\n". + "\tpod2text lib/Date/ICal.pm >! README\n". + "\techo '------------------------------------------------' >> README\n". + "\tpod2text lib/Date/ICal/Duration.pm >> README\n" +} + diff --git a/README b/README new file mode 100644 index 0000000..a5ee819 --- /dev/null +++ b/README @@ -0,0 +1,540 @@ +NAME + Date::ICal - Perl extension for ICalendar date objects. + +VERSION + $Rev: 368 $ + +SYNOPSIS + use Date::ICal; + + $ical = Date::ICal->new( ical => '19971024T120000' ); + $ical = Date::ICal->new( epoch => time ); + $ical = Date::ICal->new( year => 1964, + month => 10, day => 16, hour => 16, + min => 12, sec => 47, tz => '0530' ); + + $hour = $ical->hour; + $year = $ical->year; + + $ical_string = $ical->ical; + $epoch_time = $ical->epoch; + + $ical2 = $ical + $duration; + + (Where $duration is either a duration string, like 'P2W3DT7H9M', or a + Date::ICal::Duration (qv) object. + + $ical += 'P6DT12H'; + + $duration = $ical1 - $ical2; + $ical3 = $ical1 - $duration; + +DESCRIPTION + Date::ICal talks the ICal date format, and is intended to be a base + class for other date/calendar modules that know about ICal time format + also. + +AUTHOR + Rich Bowen + + Last touched by $Author: rbowen $ + +METHODS + Date::ICal has the following methods available: + + new + + A new Date::ICal object can be created with any valid ICal string: + + my $ical = Date::ICal->new( ical => '19971024T120000' ); + # will default to the timezone specified in $TZ, see below + + Or with any epoch time: + + my $ical = Date::ICal->new( epoch => time ); + + Or, better still, create it with components + + my $date = Date::ICal->new( + day => 25, + month => 10, + year => 1066, + hour => 7, + min => 15, + sec => 47 + ); + + If you call new without any arguments, you'll get a Date::ICal object + that is set to the time right now. + + my $ical = Date::ICal->new(); + + If you already have an object in Date::ICal, or some other subclass + thereof, you can create a new Date::ICal (or subclass) object using that + object to start with. This is particularly useful for converting from + one calendar to another: + + # Direct conversion from Discordian to ISO dates + my $disco = Date::Discordian->new( disco => '12 Chaos, YOLD 3177' ); + my $iso = Date::ISO->new( $disco ); + print $iso->iso; + + new() handles timezones. It defaults times to UTC (Greenwich Mean Time, + also called Zulu). If you want to set up a time that's in the US + "Pacific" timezone, which is GMT-8, use something like: + + my $ical = Date::ICal->new( ical => '19971024T120000', + offset => "-0800"); + + Note that as of version 1.44, new() tries to be intelligent about + figuring out your local time zone. If you enter a time that's not + *explicitly* in UTC, it looks at the environment variable $TZ, if it + exists, to determine your local offset. If $TZ isn't set, new() will + complain. + + ical + + $ical_string = $ical->ical; + + Retrieves, or sets, the date on the object, using any valid ICal + date/time string. Output is in UTC (ends with a "Z") by default. To get + output in localtime relative to the current machine, do: + + $ical_string = $ical->ical( localtime => 1 ); + + To get output relative to an arbitrary offset, do: + + $ical_string = $ical->ical( offset => '+0545' ); + + epoch + + $epoch_time = $ical->epoch; + + $ical->epoch( 98687431 ); + + Sets, or retrieves, the epoch time represented by the object, if it is + representable as such. (Dates before 1971 or after 2038 will not have an + epoch representation.) + + Internals note: The ICal representation of the date is considered the + only authoritative one. This means that we may need to reconstruct the + epoch time from the ICal representation if we are not sure that they are + in synch. We'll need to do clever things to keep track of when the two + may not be in synch. And, of course, the same will go for any subclasses + of this class. + + _offset_to_seconds + + $seconds_plus_or_minus = offset_to_seconds($offset); + + Changes -0600 to -21600. Not object method, no side-effects. + + _offset_from_seconds + + $seconds_plus_or_minus = offset_from_seconds($offset_in_seconds); + + Changes -18000 (seconds) to -0600 (hours, minutes). Not object method, + no side-effects. + + offset + + $offset = $ical->offset; + + # We need tests for these. + $ical->offset( '+1100' ); # a number of hours and minutes: UTC+11 + $ical->offset( 0 ); # reset to UTC + + Sets or retrieves the offset from UTC for this time. This allows + timezone support, assuming you know what your local (or non-local) UTC + offset is. Defaults to 0. + + Internals note: all times are internally stored in UTC, even though they + may have some offset information. Offsets are internally stored in + signed integer seconds. + + BE CAREFUL about using this function on objects that were initialized + with an offset. If you started an object with: + + my $d = new(ical=>'19700101120000', offset=>'+0100'); + + and you then call: + + $d->offset('+0200'); + + you'll be saying "Yeah, I know I *said* it was in +0100, but really I + want it to be in +0200 now and forever." Which may be your intention, if + you're trying to transpose a whole set of dates to another timezone--- + but you can also do that at the presentation level, with the ical() + method. Either way will work. + + add + + $self->add( year => 3, month => 2, week => 1, day => 12, + hour => 1, minute => 34, sec => 59 ); + $date->add( duration => 'P1WT1H1M1S' ); # add 1 wk, 1 hr, 1 min, and 1 sec + + Adds a duration to a Date::ICal object. + + Supported paraters are: duration, eom_mode, year, month, week, day, + hour, min, sec or seconds. + + 'duration' is a ICalendar duration string (see duration_value). + + If a value is undefined or omitted, 1 is assumed: + + $ical->add( 'minute' ); # add a minute + + The result will be normalized. That is, the output time will have + meaningful values, rather than being 48:73 pm on the 34th of + hexadecember. + + Adding months or years can be done via three different methods, + specified by the eom_mode parameter, which then applies to all additions + (or subtractions) of months or years following it in the parameter list. + + The default, eom_mode => 'wrap', means adding months or years that + result in days beyond the end of the new month will roll over into the + following month. For instance, adding one year to Feb 29 will result in + Mar 1. + + If you specify eom_mode => 'limit', the end of the month is never + crossed. Thus, adding one year to Feb 29, 2000 will result in Feb 28, + 2001. However, adding three more years will result in Feb 28, 2004, not + Feb 29. + + If you specify eom_mode => 'preserve', the same calculation is done as + for 'limit' except that if the original date is at the end of the month + the new date will also be. For instance, adding one month to Feb 29, + 2000 will result in Mar 31, 2000. + + All additions are performed in the order specified. For instance, with + the default setting of eom_mode => 'wrap', adding one day and one month + to Feb 29 will result in Apr 1, while adding one month and one day will + result in Mar 30. + + add_overload + + $date = $date1 + $duration; + + Where $duration is either a duration string, or a Date::ICal::Duration + object. + + $date += 'P2DT4H7M'; + + Adds a duration to a date object. Returns a new object, or, in the case + of +=, modifies the existing object. + + duration_value + + Given a duration string, this function returns the number of days, + seconds, and months represented by that duration. In that order. Seems + odd to me. This should be considered an internal function, and you + should expect the API to change in the very near future. + + subtract + + $duration = $date1 - $date2; + + Subtract one Date::ICal object from another to give a duration - the + length of the interval between the two dates. The return value is a + Date::ICal::Duration object (qv) and allows you to get at each of the + individual components, or the entire duration string: + + $d = $date1 - $X; + + Note that $X can be any of the following: + + If $X is another Date::ICal object (or subclass thereof) then $d will be + a Date::ICal::Duration object. + + $week = $d->weeks; # how many weeks apart? + $days = $d->as_days; # How many days apart? + + If $X is a duration string, or a Date::ICal::Diration object, then $d + will be an object in the same class as $date1; + + $newdate = $date - $duration; + + clone + + $copy = $date->clone; + + Returns a replica of the date object, including all attributes. + + compare + + $cmp = $date1->compare($date2); + + @dates = sort {$a->compare($b)} @dates; + + Compare two Date::ICal objects. Semantics are compatible with sort; + returns -1 if $a < $b, 0 if $a == $b, 1 if $a > $b. + + day + + my $day = $date->day; + + Returns the day of the month. + + Day is in the range 1..31 + + month + + my $month = $date->month; + + Returns the month of the year. + + Month is returned as a number in the range 1..12 + + year + + my $year = $date->year; + + Returns the year. + + jd2greg + + ($year, $month, $day) = jd2greg( $jd ); + + Convert number of days on or after Jan 1, 1 CE (Gregorian) to + gregorian year,month,day. + + greg2jd + + $jd = greg2jd( $year, $month, $day ); + + Convert gregorian year,month,day to days on or after Jan 1, 1 CE + (Gregorian). Normalization is performed (e.g. month of 28 means + April two years after given year) for month < 1 or > 12 or day < 1 + or > last day of month. + + days_this_year + + $yday = Date::ICal::days_this_year($day, $month, $year); + + Returns the number of days so far this year. Analogous to the yday + attribute of gmtime (or localtime) except that it works outside of the + epoch. + + day_of_week + + my $day_of_week = $date->day_of_week + + Returns the day of week as 0..6 (0 is Sunday, 6 is Saturday). + + hour + + my $hour = $date->hour + + Returns the hour of the day. + + Hour is in the range 0..23 + + min + + my $min = $date->min; + + Returns the minute. + + Minute is in the range 0..59 + + sec + + my $sec = $date->sec; + + Returns the second. + + Second is in the range 0..60. The value of 60 is (maybe) needed for leap + seconds. But I'm not sure if we're going to go there. + + julian + + my $jd = $date->jd; + + Returns a listref, containing two elements. The date as a julian day, + and the time as the number of seconds since midnight. This should not be + thought of as a real julian day, because it's not. The module is + internally consistent, and that's enough. + + This method really only is here for compatibility with previous + versions, as the jd method is now thrown over for plain hash references. + + See the file INTERNALS for more information about this internal format. + +TODO + - add gmtime and localtime methods, perhaps? + - Fix the INTERNALS file so that it actually reflects reality +INTERNALS + Please see the file INTERNALS for discussion on the internals. + +AUTHOR + Rich Bowen (DrBacchus) rbowen@rcbowen.com + + And the rest of the Reefknot team. See the source for a full list of + patch contributors and version-by-version notes. + +SEE ALSO + datetime@perl.org mailing list + + http://datetime.perl.org/ + + Time::Local + + Net::ICal + +------------------------------------------------ +NAME + Date::ICal::Duration - durations in iCalendar format, for math purposes. + +VERSION + $Revision: 368 $ + +SYNOPSIS + use Date::ICal::Duration; + + $d = Date::ICal::Duration->new( ical => '-P1W3DT2H3M45S' ); + + $d = Date::ICal::Duration->new( weeks => 1, + days => 1, + hours => 6, + minutes => 15, + seconds => 45); + + # a one hour duration, without other components + $d = Date::ICal::Duration->new( seconds => "3600"); + + # Read-only accessors: + $d->weeks; + $d->days; + $d->hours; + $d->minutes; + $d->seconds; + $d->sign; + + # TODO: Resolve sign() discussion from rk-devel and update synopsis. + + $d->as_seconds (); # returns just seconds + $d->as_elements (); # returns a hash of elements, like the accessors above + $d->as_ical(); # returns an iCalendar duration string + +DESCRIPTION + This is a trivial class for representing duration objects, for doing + math in Date::ICal + +AUTHOR + Rich Bowen, and the Reefknot team. + + Last touched by $Author: rbowen $ + +METHODS + Date::ICal::Duration has the following methods available: + + new + + A new Date::ICal::Duration object can be created with an iCalendar + string : + + my $ical = Date::ICal::Duration->new ( ical => 'P3W2D' ); + # 3 weeks, 2 days, positive direction + my $ical = Date::ICal::Duration->new ( ical => '-P6H3M30S' ); + # 6 hours, 3 minutes, 30 seconds, negative direction + + Or with a number of seconds: + + my $ical = Date::ICal::Duration->new ( seconds => "3600" ); + # one hour positive + + Or, better still, create it with components + + my $date = Date::ICal::Duration->new ( + weeks => 6, + days => 2, + hours => 7, + minutes => 15, + seconds => 47, + sign => "+" + ); + + The sign defaults to "+", but "+" and "-" are legal values. + + sign, weeks, days, hours, minutes, seconds + + Read-only accessors for the elements of the object. + + as_seconds + + Returns the duration in raw seconds. + + WARNING -- this folds in the number of days, assuming that they are + always 86400 seconds long (which is not true twice a year in areas that + honor daylight savings time). If you're using this for date arithmetic, + consider using the *add()* method from a the Date::ICal manpage object, + as this will behave better. Otherwise, you might experience some error + when working with times that are specified in a time zone that observes + daylight savings time. + + as_days + + $days = $duration->as_days; + + Returns the duration as a number of days. Not to be confused with the + "days" method, this method returns the total number of days, rather than + mod'ing out the complete weeks. Thus, if we have a duration of 33 days, + "weeks" will return 4, "days" will return 5, but "as_days" will return + 33. + + Note that this is a lazy convenience function which is just weeks*7 + + days. + + as_ical + + Return the duration in an iCalendar format value string (e.g., + "PT2H0M0S") + + as_elements + + Returns the duration as a hashref of elements. + +INTERNALS + head2 GENERAL MODEL + + Internally, we store 3 data values: a number of days, a number of + seconds (anything shorter than a day), and a sign (1 or -1). We are + assuming that a day is 24 hours for purposes of this module; yes, we + know that's not completely accurate because of daylight-savings-time + switchovers, but it's mostly correct. Suggestions are welcome. + + NOTE: The methods below SHOULD NOT be relied on to stay the same in + future versions. + + _set_from_ical ($self, $duration_string) + + Converts a RFC2445 DURATION format string to the internal storage + format. + + _parse_ical_string ($string) + + Regular expression for parsing iCalendar into usable values. + + _set_from_components ($self, $hashref) + + Converts from a hashref to the internal storage format. The hashref can + contain elements "sign", "weeks", "days", "hours", "minutes", "seconds". + + _set_from_ical ($self, $num_seconds) + + Sets internal data storage properly if we were only given seconds as a + parameter. + + $self->_hms(); + + Return an arrayref to hours, minutes, and second components, or undef if + nsecs is undefined. If given an arrayref, computes the new nsecs value + for the duration. + + $self->_wd() + + Return an arrayref to weeks and day components, or undef if ndays is + undefined. If Given an arrayref, computs the new ndays value for the + duration. + diff --git a/lib/Date/ICal.pm b/lib/Date/ICal.pm new file mode 100755 index 0000000..39844af --- /dev/null +++ b/lib/Date/ICal.pm @@ -0,0 +1,1287 @@ +# $Rev: 678 $ +package Date::ICal; +use strict; + +use vars qw($VERSION $localzone $localoffset @months @leapmonths %add_units); +$VERSION = '2.'.(qw'$Rev: 678 $')[1]; +use Carp; +use Time::Local; +use Date::Leapyear qw(); +use Date::ICal::Duration; +use overload '<=>' => 'compare', + 'fallback' => 1, + '-' => \&subtract, + '+' => \&add_overload; + +$localzone = $ENV{TZ} || 0; +$localoffset = _calc_local_offset(); + +# Documentation {{{ + +=head1 NAME + +Date::ICal - Perl extension for ICalendar date objects. + +=head1 VERSION + +$Revision: 678 $ + +=head1 SYNOPSIS + + use Date::ICal; + + $ical = Date::ICal->new( ical => '19971024T120000' ); + $ical = Date::ICal->new( epoch => time ); + $ical = Date::ICal->new( year => 1964, + month => 10, day => 16, hour => 16, + min => 12, sec => 47 ); + + $hour = $ical->hour; + $year = $ical->year; + + $ical_string = $ical->ical; + $epoch_time = $ical->epoch; + + $ical2 = $ical + $duration; + +(Where $duration is either a duration string, like 'P2W3DT7H9M', or a +Date::ICal::Duration (qv) object. + + $ical += 'P6DT12H'; + + $duration = $ical - $ical2; + $ical3 = $ical - $duration; + +=head1 DESCRIPTION + +Date::ICal talks the ICal date format, and is intended to be a base class for +other date/calendar modules that know about ICal time format also. + +=head1 AUTHOR + +Rich Bowen, and the Reefknot team. Alas, Reefknot is no more. See +http://datetime.perl.org/ for more modern and accurate modules. + +Last touched by $Author: rbowen $ + +=head1 METHODS + +Date::ICal has the following methods available: + +=head2 new + +A new Date::ICal object can be created with any valid ICal string: + + my $ical = Date::ICal->new( ical => '19971024T120000' ); + # will default to the timezone specified in $TZ, see below + +Or with any epoch time: + + my $ical = Date::ICal->new( epoch => time ); + +Or, better still, create it with components + + my $date = Date::ICal->new( + day => 25, + month => 10, + year => 1066, + hour => 7, + min => 15, + sec => 47 + ); + +If you call new without any arguments, you'll get a Date::ICal object that is +set to the time right now. + + my $ical = Date::ICal->new(); + +If you already have an object in Date::ICal, or some other subclass +thereof, you can create a new Date::ICal (or subclass) object using +that object to start with. This is particularly useful for converting +from one calendar to another: + + # Direct conversion from Discordian to ISO dates + my $disco = Date::Discordian->new( disco => '12 Chaos, YOLD 3177' ); + my $iso = Date::ISO->new( $disco ); + print $iso->iso; + +new() handles timezones. It defaults times to UTC (Greenwich +Mean Time, also called Zulu). If you want to set up a time +that's in the US "Pacific" timezone, which is GMT-8, use something +like: + + my $ical = Date::ICal->new( ical => '19971024T120000', + offset => "-0800"); + +Note that as of version 1.44, new() tries to be intelligent +about figuring out your local time zone. If you enter +a time that's not *explicitly* in UTC, it looks at +the environment variable $TZ, if it exists, to determine +your local offset. If $TZ isn't set, new() will complain. + +=cut + +#}}} + +#{{{ sub new + +sub new { + my $class = shift; + my ( $self, %args, $sec, $min, $hour, $day, $month, $year, $tz ); + + # $zflag indicates whether or not this time is natively in UTC + my $zflag = 0; + + # First argument can be a Date::ICal (or subclass thereof) object + if ( ref $_[0] ) { + $args{ical} = $_[0]->ical; + } else { + %args = @_; + } + + $self = {}; + + # Date is specified as epoch#{{{ + if ( defined( $args{epoch} ) ) { + + ( $sec, $min, $hour, $day, $month, $year ) = + ( gmtime( $args{epoch} ) )[ 0, 1, 2, 3, 4, 5 ]; + $year += 1900; + $month++; + + $zflag = 1; # epoch times are by definition in GMT + } #}}} + + # Date is specified as ical string#{{{ + elsif ( defined( $args{ical} ) ) { + + # Timezone, if any + $args{ical} =~ s/^(?:TZID=([^:]+):)?//; + $tz = $1; + + # Split up ical string + ( $year, $month, $day, $hour, $min, $sec, $zflag ) = + $args{ical} =~ /^(?:(\d{4})(\d\d)(\d\d)) + (?:T(\d\d)?(\d\d)?(\d\d)?)? + (Z)?$/x; + + # TODO: figure out what to do if we get a TZID. + # I'd suggest we store it for use by modules that care + # about TZID names. But we don't want this module + # to deal with timezone names, only offsets, I think. + # --srl + + } #}}} + + # Time specified as components#{{{ + elsif ( defined( $args{day} ) ) { + + # Choke if missing arguments + foreach my $attrib(qw(day month year )) { + warn "Attribute $attrib required" unless defined $args{$attrib}; + } + foreach my $attrib(qw( hour min sec )) { + $args{$attrib} = 0 unless defined $args{$attrib}; + } + + # And then just use what was passed in + ( $sec, $min, $hour, $day, $month, $year ) = + @args{ 'sec', 'min', 'hour', 'day', 'month', 'year' }; + + } #}}} + + else { # Just use current gmtime#{{{ + + # Since we are defaulting, this qualifies as UTC + $zflag = 1; + + ( $sec, $min, $hour, $day, $month, $year ) = ( gmtime(time) )[ 0 .. 5 ]; + $year += 1900; + $month++; + } #}}} + + $self->{julian} = greg2jd( $year, $month, $day ); + $self->{julsec} = time_as_seconds( $hour, $min, $sec ); + bless $self, $class; + + if ( exists( $args{offset} ) ) { + # We should complain if they're trying to set a non-UTC + # offset on a time that's inherently UTC. -jv + if ($zflag && ($args{offset} != 0)) { + carp "Time had conflicting offset and UTC info. Using UTC" + unless $ENV{HARNESS_ACTIVE}; + } else { + + # Set up the offset for this datetime. + $self->offset( $args{offset} || 0 ); + } + } elsif ( !$zflag ) { + + # Check if the timezone has changed since the last time we checked. + # Apparently this happens on some systems. Patch from Mike + # Heins. Ask him. + my $tz = $ENV{TZ} || '0'; + my $loc = $tz eq $localzone ? $localoffset : _calc_local_offset(); + $self->offset($loc) if defined $self; + } + + return $self; +} + +#}}} + +#{{{ sub ical + +=head2 ical + + $ical_string = $ical->ical; + +Retrieves, or sets, the date on the object, using any valid ICal date/time +string. Output is in UTC (ends with a "Z") by default. To get +output in localtime relative to the current machine, do: + + $ical_string = $ical->ical( localtime => 1 ); + +To get output relative to an arbitrary offset, do: + + $ical_string = $ical->ical( offset => '+0545' ); + +=cut + +sub ical { + my $self = shift; + if ( 1 & @_ ) { # odd number of parameters? + carp "Bad args: expected named parameter list"; + shift; # avoid warning from %args=@_ assignment + } + my %args = @_; + my $ical; + + if ( exists $args{localtime} ) { + carp "can't have localtime and offset together, using localtime offset" + if exists $args{offset}; + + # make output in localtime format by setting $args{offset} + $args{offset} = $self->offset; + } + + if ( exists $args{offset} ) { + + # make output based on an arbitrary offset + # No Z on the end! + my $julian = $self->{julian}; + my $julsec = $self->{julsec}; + my $adjust = offset_to_seconds( $args{offset} ); + $self->add( seconds => $adjust ); + $ical = + sprintf( '%04d%02d%02dT%02d%02d%02d', $self->year, $self->month, + $self->day, $self->hour, $self->minute, $self->second, ); + $self->{julian} = $julian; + $self->{julsec} = $julsec; + } else { + + # make output in UTC by default + # if we were originally given this time in offset + # form, we'll need to adjust it for output + if ( $self->hour || $self->min || $self->sec ) { + $ical = + sprintf( '%04d%02d%02dT%02d%02d%02dZ', $self->year, $self->month, + $self->day, $self->hour, $self->minute, $self->second ); + } else { + $ical = + sprintf( '%04d%02d%02dZ', $self->year, $self->month, $self->day ); + } + } + + return $ical; +} #}}} + +#{{{ sub epoch + +=head2 epoch + + $epoch_time = $ical->epoch; + + $ical->epoch( 98687431 ); + +Sets, or retrieves, the epoch time represented by the object, if it is +representable as such. (Dates before 1971 or after 2038 will not have an epoch +representation.) + +Internals note: The ICal representation of the date is considered the only +authoritative one. This means that we may need to reconstruct the epoch time +from the ICal representation if we are not sure that they are in synch. We'll +need to do clever things to keep track of when the two may not be in synch. +And, of course, the same will go for any subclasses of this class. + +=cut + +sub epoch { + my $self = shift; + my $class = ref($self); + + my $epoch; + + if ( $epoch = shift ) { # Passed in a new value + + my $newepoch = $class->new( epoch => $epoch ); + $self->{julian} = $newepoch->{julian}; + $self->{julsec} = $newepoch->{julsec}; + + } + + else { # Calculate epoch from components, if possible + + $epoch = + timegm( $self->sec, $self->min, $self->hour, $self->day, + ( $self->month ) - 1, ( $self->year ) - 1900 ); + } + + return $epoch; +} + +#}}} + +#{{{ sub offset_to_seconds + +=head2 offset_to_seconds + + $seconds_plus_or_minus = offset_to_seconds($offset); + +Changes -0600 to -21600. Not object method, no side-effects. + +=cut + +sub offset_to_seconds { + my $offset = shift; + + # Relocated from offset for re-use + my $newoffset; + + if ( $offset eq '0' ) { + $newoffset = 0; + } elsif ( $offset =~ /^([+-])(\d\d)(\d\d)\z/ ) + { + my ( $sign, $hours, $minutes ) = ( $1, $2, $3 ); + + # convert to seconds, ignoring the possibility of leap seconds + # or daylight-savings-time shifts + $newoffset = $hours * 60 * 60 + $minutes * 60; + $newoffset *= -1 if $sign eq '-'; + } else { + carp("You gave an offset, $offset, that makes no sense"); + return undef; + } + return $newoffset; +} + +#}}} + +#{{{ sub offset_from_seconds + +=head2 offset_from_seconds + + $seconds_plus_or_minus = offset_from_seconds($offset_in_seconds); + +Changes -18000 (seconds) to -0600 (hours, minutes). +Not object method, no side-effects. + +=cut + +sub offset_from_seconds { + my $secoffset = shift; + my $hhmmoffset = 0; + + if ( $secoffset ne '0' ) { + my ( $sign, $secs ) = ( "", "" ); + ( $sign, $secs ) = $secoffset =~ /([+-])?(\d+)/; + + # throw in a + to make this look like an offset if positive + $sign = "+" unless $sign; + + # NOTE: the following code will return "+0000" if you give it a number + # of seconds that are a multiple of a day. However, for speed reasons + # I'm not going to write in a comparison to reformat that back to 0. + # + my $hours = $secs / ( 60 * 60 ); + $hours = $hours % 24; + my $mins = ( $secs % ( 60 * 60 ) ) / 60; + $hhmmoffset = sprintf( '%s%02d%02d', $sign, $hours, $mins ); + + } + + return $hhmmoffset; +} + +#}}} + +#{{{ sub offset + +=head2 offset + + $offset = $ical->offset; + + # We need tests for these. + $ical->offset( '+1100' ); # a number of hours and minutes: UTC+11 + $ical->offset( 0 ); # reset to UTC + +Sets or retrieves the offset from UTC for this time. This allows +timezone support, assuming you know what your local (or non-local) +UTC offset is. Defaults to 0. + +Internals note: all times are internally stored in UTC, even though they +may have some offset information. Offsets are internally stored in +signed integer seconds. + +BE CAREFUL about using this function on objects that were initialized +with an offset. If you started an object with: + + my $d = new(ical=>'19700101120000', offset=>'+0100'); + +and you then call: + + $d->offset('+0200'); + +you'll be saying "Yeah, I know I *said* it was in +0100, but really I +want it to be in +0200 now and forever." Which may be your intention, +if you're trying to transpose a whole set of dates to another timezone--- +but you can also do that at the presentation level, with +the ical() method. Either way will work. + +=cut + +sub offset { + my ( $self, $offset ) = @_; + my $newoffset = undef; + + if ( defined($offset) ) { # Passed in a new value + $newoffset = offset_to_seconds($offset); + + unless ( defined $newoffset ) { return undef; } + + # since we're internally storing in GMT, we need to + # adjust the time we were given by the offset so that + # the internal date/time will be right. + + if ( $self->{offset} ) { + + # figure out whether there's a difference between + # the existing offset and the offset we were given. + # If so, adjust appropriately. + my $offsetdiff = $self->{offset} - $newoffset; + + if ($offsetdiff) { + $self->{offset} = $newoffset; + $self->add( seconds => $offsetdiff ); + } else { + + # leave the offset the way it is + } + } else { + $self->add( seconds => -$newoffset ); + $self->{offset} = $newoffset; + } + + } else { + if ( $self->{offset} ) { + $offset = offset_from_seconds( $self->{offset} ); + } else { + $offset = 0; + } + } + + return $offset; +} + +#}}} + +# sub add {{{ + +=head2 add + + $self->add( year => 3, month => 2, week => 1, day => 12, + hour => 1, minute => 34, sec => 59 ); + $date->add( duration => 'P1WT1H1M1S' ); # add 1 wk, 1 hr, 1 min, and 1 sec + +Adds a duration to a Date::ICal object. + +Supported paraters are: duration, eom_mode, year, month, week, day, +hour, min, sec or seconds. + +'duration' is a ICalendar duration string (see duration_value). + +If a value is undefined or omitted, 1 is assumed: + + $ical->add( 'minute' ); # add a minute + +The result will be normalized. That is, the output time will have +meaningful values, rather than being 48:73 pm on the 34th of +hexadecember. + +Adding months or years can be done via three different methods, +specified by the eom_mode parameter, which then applies to all +additions (or subtractions) of months or years following it in the +parameter list. + +The default, eom_mode => 'wrap', means adding months or years that +result in days beyond the end of the new month will roll over into the +following month. For instance, adding one year to Feb 29 will result +in Mar 1. + +If you specify eom_mode => 'limit', the end of the month is never +crossed. Thus, adding one year to Feb 29, 2000 will result in Feb 28, +2001. However, adding three more years will result in Feb 28, 2004, +not Feb 29. + +If you specify eom_mode => 'preserve', the same calculation is done as +for 'limit' except that if the original date is at the end of the +month the new date will also be. For instance, adding one month to +Feb 29, 2000 will result in Mar 31, 2000. + +All additions are performed in the order specified. For instance, +with the default setting of eom_mode => 'wrap', adding one day and one +month to Feb 29 will result in Apr 1, while adding one month and one +day will result in Mar 30. + +=cut + +sub add { + my $self = shift; + carp "Date::ICal::add was called without an attribute arg" unless @_; + ( $self->{julian}, $self->{julsec}) = + _add($self->{julian}, $self->{julsec}, @_); + return $self; +} + +#}}} + +# sub _add {{{ + +=begin internal + + Add (or subtract) to a date/time. First two parameters are + the jd and secs of the day. For the rest, see the add method. + Returns the adjusted jd and secs. + +=end internal + +=cut + +# for each unit, specify what it changes by (0=day, 1=second, 2=month) +# and by what factor + +%add_units = (year=>[2,12], month=>[2,1], week=>[0,7], day=>[0,1], + hour=>[1,3600], min=>[1,60], sec=>[1,1], seconds=>[1,1]); + +sub _add { + my ($jd, $secs) = splice(@_, 0, 2); + my $eom_mode = 0; + my ($add, $unit, $count); + + # loop through unit=>count parameters + while (($unit, $count) = splice(@_, 0, 2)) { + + if ($unit eq 'duration') { # add a duration string + my %dur; + @dur{'day','sec','month'} = duration_value($count); + + # pretend these were passed to us as e.g. month=>1, day=>1, sec=>1. + # since months/years come first in the duration string, we + # put them first. + unshift @_, map $dur{$_} ? ($_,$dur{$_}) : (), + 'month', 'day', 'sec'; + next; + } elsif ($unit eq 'eom_mode') { + if ($count eq 'wrap') { $eom_mode = 0 } + elsif ($count eq 'limit') { $eom_mode = 1 } + elsif ($count eq 'preserve') { $eom_mode = 2 } + else { carp "Unrecognized eom_mode, $count, ignored" } + } else { + unless ($add = $add_units{$unit}) { + carp "Unrecognized time unit, $unit, skipped"; + next; + } + + $count = 1 if !defined $count; # count defaults to 1 + $count *= $add->[1]; # multiply by the factor for this unit + + if ($add->[0] == 0) { # add to days + $jd += $count; + } elsif ($add->[0] == 1) { # add to seconds + $secs += $count; + } else { # add to months + my ($y, $mo, $d); + + _normalize_seconds( $jd, $secs ); + if ($eom_mode == 2) { # sticky eom mode + # if it is the last day of the month, make it the 0th + # day of the following month (which then will normalize + # back to the last day of the new month). + ($y, $mo, $d) = jd2greg( $jd+1 ); + --$d; + } else { + ($y, $mo, $d) = jd2greg( $jd ); + } + + if ($eom_mode && $d > 28) { # limit day to last of new month + # find the jd of the last day of our target month + $jd = greg2jd( $y, $mo+$count+1, 0 ); + + # what day of the month is it? (discard year and month) + my $lastday = scalar jd2greg( $jd ); + + # if our original day was less than the last day, + # use that instead + $jd -= $lastday - $d if $lastday > $d; + } else { + $jd = greg2jd( $y, $mo+$count, $d ); + } + } + } + } + + _normalize_seconds( $jd, $secs ); +} + +#}}} + +# sub add_overload {{{ + +=head2 add_overload + + $date = $date1 + $duration; + +Where $duration is either a duration string, or a Date::ICal::Duration +object. + + $date += 'P2DT4H7M'; + +Adds a duration to a date object. Returns a new object, or, in the case +of +=, modifies the existing object. + +=cut + +sub add_overload { + my $one = shift; + my $two = shift; + + my $ret = $one->clone; + + if ( ref $two ) { + $ret->add( duration => $two->as_ical ); + } else { + $ret->add( duration => $two ); + } + + return $ret; +} # }}} + +# sub _normalize_seconds {{{ + +=begin internal + + ($jd, $secs) = _normalize_seconds( $jd, $secs ); + + Corrects seconds that have gone into following or previous day(s). + Adjusts the passed days and seconds as well as returning them. + +=end internal + +=cut + +sub _normalize_seconds { + my $adj; + + if ($_[1] < 0) { + $adj = int( ($_[1]-86399)/86400 ); + } else { + $adj = int( $_[1]/86400 ); + } + ($_[0] += $adj), ($_[1] -= $adj*86400); +} + +#}}} + +# sub duration_value {{{ + +=head2 duration_value + +Given a duration string, this function returns the number of days, +seconds, and months represented by that duration. In that order. Seems +odd to me. This should be considered an internal function, and you +should expect the API to change in the very near future. + +=cut + +sub duration_value { + my $str = shift; + + my @temp = $str =~ m{ + ([\+\-])? (?# Sign) + (P) (?# 'P' for period? This is our magic character) + (?: + (?:(\d+)Y)? (?# Years) + (?:(\d+)M)? (?# Months) + (?:(\d+)W)? (?# Weeks) + (?:(\d+)D)? (?# Days) + )? + (?:T (?# Time prefix) + (?:(\d+)H)? (?# Hours) + (?:(\d+)M)? (?# Minutes) + (?:(\d+)S)? (?# Seconds) + )? + }x; + my ( $sign, $magic ) = @temp[ 0 .. 1 ]; + my ( $years, $months, $weeks, $days, $hours, $mins, $secs ) = + map { defined($_) ? $_ : 0 } @temp[ 2 .. $#temp ]; + + unless ( defined($magic) ) { + carp "Invalid duration: $str"; + return undef; + } + $sign = ( ( defined($sign) && $sign eq '-' ) ? -1 : 1 ); + + my $s = $sign * ( $secs + ( $mins * 60 ) + ( $hours * 3600 ) ); + my $d = $sign * ( $days + ( $weeks * 7 ) ); + my $m = $sign * ( $months + ( $years * 12 ) ); + return ( $d, $s, $m ); +} + +#}}} + +# sub subtract {{{ + +=head2 subtract + + $duration = $date1 - $date2; + +Subtract one Date::ICal object from another to give a duration - the +length of the interval between the two dates. The return value is a +Date::ICal::Duration object (qv) and allows you to get at each of the +individual components, or the entire duration string: + + $d = $date1 - $X; + +Note that $X can be any of the following: + +If $X is another Date::ICal object (or subclass thereof) then $d will be +a Date::ICal::Duration object. + + $week = $d->weeks; # how many weeks apart? + $days = $d->as_days; # How many days apart? + +If $X is a duration string, or a Date::ICal::Diration object, then $d +will be an object in the same class as $date1; + + $newdate = $date - $duration; + +=cut + +sub subtract { + my ( $date1, $date2, $reversed ) = @_; + my $dur; + + # If the order of the arguments was reversed, overload tells us + # about it in the third argument. + if ($reversed) { + ( $date2, $date1 ) = ( $date1, $date2 ); + } + + if (ref $date1 && ref $date2) { + # If $date1 is a Date::ICal object, and $date2 is a Duration object, + # then we should subtract and get a date. + if ((ref $date2) eq 'Date::ICal::Duration') { + my $seconds = $date2->as_seconds; + my $ret = $date1->clone; + $ret->add( seconds => -1 * $seconds ); + return $ret; + + } else { + # If $date2 is a Date::ICal object, or some class thereof, we should + # subtract and get a duration + + my $days = $date1->{julian} - $date2->{julian}; + my $secs = $date1->{julsec} - $date2->{julsec}; + + return Date::ICal::Duration->new( + days => $days, + seconds => $secs + ); + } + } elsif ( ref $date1 && + ( $dur = Date::ICal::Duration->new( ical => $date2 ) ) + ) { + # If $date1 is a Date::ICal object, and $date2 is a duration string, + # we should subtract and get a date + return $date1 - $dur; # Is that cheating? + + # Otherwise, return undef + } else { + warn "Invalid arguments. You can subtract a date from a date, or a duration from a date"; + return; + } + +} # }}} + +# sub clone {{{ + +=head2 clone + + $copy = $date->clone; + +Returns a replica of the date object, including all attributes. + +=cut + +sub clone { + my $self = shift; + my $class = ref $self; + my %hash = %$self; + my $new = \%hash; + bless $new, $class; + return $new; +} # }}} + +# sub compare {{{ + +=head2 compare + + $cmp = $date1->compare($date2); + + @dates = sort {$a->compare($b)} @dates; + +Compare two Date::ICal objects. Semantics are compatible with +sort; returns -1 if $a < $b, 0 if $a == $b, 1 if $a > $b. + +=cut + +sub compare { + my ( $self, $otherdate ) = (@_); + + unless ( defined($otherdate) ) { return undef } + + # One or more days different + + if ( $self->{julian} < $otherdate->{julian} ) { + return -1; + } elsif ( $self->{julian} > $otherdate->{julian} ) + { + return 1; + + # They are the same day + } elsif ( $self->{julsec} < $otherdate->{julsec} ) + { + return -1; + } elsif ( $self->{julsec} > $otherdate->{julsec} ) + { + return 1; + } + + # # if we got all this way and haven't yet returned, the units are equal. + return 0; +} + +#}}} + +# internal stuff {{{ + +=begin internal + + @months = months($year); + +Returns the Julian day at the end of a month, correct for that year. + +=end internal + +=cut + +# precalculate these values at module load time so that we don't +# have to do it repeatedly during runtime. +# +BEGIN { + + # + 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 + @months = ( 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 ); + @leapmonths = @months; + + for ( 2 .. 12 ) { + $leapmonths[$_] = $months[$_] + 1; + } +} + +sub months { + return Date::Leapyear::isleap(shift) ? @leapmonths : @months; +} + +=begin internal + + time_as_seconds( $args{hour}, $args{min}, $args{sec} ); + +Returns the time of day as the number of seconds in the day. + +=end internal + +=cut + +# }}} + +# sub time_as_seconds {{{ + +sub time_as_seconds { + my ( $hour, $min, $sec ) = @_; + + $hour ||= 0; + $min ||= 0; + $sec ||= 0; + + my $secs = $hour * 3600 + $min * 60 + $sec; + return $secs; +} #}}} + +# sub day {{{ + +=head2 day + + my $day = $date->day; + +Returns the day of the month. + +Day is in the range 1..31 + +=cut + +sub day { + my $self = shift; + return ( jd2greg( $self->{julian} ) )[2]; +} # }}} + +# sub month {{{ + +=head2 month + + my $month = $date->month; + +Returns the month of the year. + +Month is returned as a number in the range 1..12 + +=cut + +sub month { + my $self = shift; + return ( jd2greg( $self->{julian} ) )[1]; +} # }}} + +# sub mon {{{ + +sub mon { return month(@_); } + +#}}} + +# sub year {{{ + +=head2 year + + my $year = $date->year; + +Returns the year. + +=cut + +sub year { + my $self = shift; + return ( jd2greg( $self->{julian} ) )[0]; +} # }}} + +# sub jd2greg {{{ + +=head2 jd2greg + + ($year, $month, $day) = jd2greg( $jd ); + + Convert number of days on or after Jan 1, 1 CE (Gregorian) to + gregorian year,month,day. + +=cut + +sub jd2greg { + use integer; + my $d = shift; + my $yadj = 0; + my ( $c, $y, $m ); + + # add 306 days to make relative to Mar 1, 0; also adjust $d to be within + # a range (1..2**28-1) where our calculations will work with 32bit ints + if ( $d > 2**28 - 307 ) { + + # avoid overflow if $d close to maxint + $yadj = ( $d - 146097 + 306 ) / 146097 + 1; + $d -= $yadj * 146097 - 306; + } elsif ( ( $d += 306 ) <= 0 ) + { + $yadj = + -( -$d / 146097 + 1 ); # avoid ambiguity in C division of negatives + $d -= $yadj * 146097; + } + + $c = + ( $d * 4 - 1 ) / 146097; # calc # of centuries $d is after 29 Feb of yr 0 + $d -= $c * 146097 / 4; # (4 centuries = 146097 days) + $y = ( $d * 4 - 1 ) / 1461; # calc number of years into the century, + $d -= $y * 1461 / 4; # again March-based (4 yrs =~ 146[01] days) + $m = + ( $d * 12 + 1093 ) / 367; # get the month (3..14 represent March through + $d -= ( $m * 367 - 1094 ) / 12; # February of following year) + $y += $c * 100 + $yadj * 400; # get the real year, which is off by + ++$y, $m -= 12 if $m > 12; # one if month is January or February + return ( $y, $m, $d ); +} #}}} + +# sub greg2jd {{{ + +=head2 greg2jd + + $jd = greg2jd( $year, $month, $day ); + + Convert gregorian year,month,day to days on or after Jan 1, 1 CE + (Gregorian). Normalization is performed (e.g. month of 28 means + April two years after given year) for month < 1 or > 12 or day < 1 + or > last day of month. + +=cut + +sub greg2jd { + use integer; + my ( $y, $m, $d ) = @_; + my $adj; + + # make month in range 3..14 (treat Jan & Feb as months 13..14 of prev year) + if ( $m <= 2 ) { + $y -= ( $adj = ( 14 - $m ) / 12 ); + $m += 12 * $adj; + } elsif ( $m > 14 ) + { + $y += ( $adj = ( $m - 3 ) / 12 ); + $m -= 12 * $adj; + } + + # make year positive (oh, for a use integer 'sane_div'!) + if ( $y < 0 ) { + $d -= 146097 * ( $adj = ( 399 - $y ) / 400 ); + $y += 400 * $adj; + } + + # add: day of month, days of previous 0-11 month period that began w/March, + # days of previous 0-399 year period that began w/March of a 400-multiple + # year), days of any 400-year periods before that, and 306 days to adjust + # from Mar 1, year 0-relative to Jan 1, year 1-relative (whew) + + $d += ( $m * 367 - 1094 ) / 12 + $y % 100 * 1461 / 4 + + ( $y / 100 * 36524 + $y / 400 ) - 306; +} # }}} + +# sub days_this_year {{{ + +=head2 days_this_year + + $yday = Date::ICal::days_this_year($day, $month, $year); + +Returns the number of days so far this year. Analogous to the yday +attribute of gmtime (or localtime) except that it works outside of the +epoch. + +=cut + +sub days_this_year { + my ( $d, $m, $y ) = @_; + my @mlist = &months($y); + return $mlist[$m - 1] + $d - 1; +} #}}} + +# sub day_of_week {{{ + +=head2 day_of_week + + my $day_of_week = $date->day_of_week + +Returns the day of week as 0..6 (0 is Sunday, 6 is Saturday). + +=cut + +sub day_of_week { + my $self = shift; + return $self->{julian} % 7; +} #}}} + +# sub hour {{{ + +=head2 hour + + my $hour = $date->hour + +Returns the hour of the day. + +Hour is in the range 0..23 + +=cut + +sub hour { + my $self = shift; + return ( $self->parsetime )[2]; +} # }}} + +# sub min {{{ + +=head2 min + + my $min = $date->min; + +Returns the minute. + +Minute is in the range 0..59 + +=cut + +sub min { + my $self = shift; + return ( $self->parsetime )[1]; +} + +sub minute { return min(@_); } + +# }}} + +# sub sec {{{ + +=head2 sec + + my $sec = $date->sec; + +Returns the second. + +Second is in the range 0..60. The value of 60 is (maybe) needed for +leap seconds. But I'm not sure if we're going to go there. + +=cut + +sub sec { + my $self = shift; + return ( $self->parsetime )[0]; +} + +sub second { return sec(@_); } + +# }}} + +# sub parsetime {{{ + +=begin internal + + ( $sec, $min, $hour ) = parsetime( $seconds ); + +Given the number of seconds so far today, returns the seconds, +minutes, and hours of the current time. + +=end internal + +=cut + +sub parsetime { + my $self = shift; + my $time = $self->{julsec}; + + my $hour = int( $time / 3600 ); + $time -= $hour * 3600; + + my $min = int( $time / 60 ); + $time -= $min * 60; + + return ( int($time), $min, $hour ); +} # }}} + +# sub julian/jd #{{{ + +=head2 julian + + my $jd = $date->jd; + +Returns a listref, containing two elements. The date as a julian day, +and the time as the number of seconds since midnight. This should not +be thought of as a real julian day, because it's not. The module is +internally consistent, and that's enough. + +This method really only is here for compatibility with previous +versions, as the jd method is now thrown over for plain hash references. + +See the file INTERNALS for more information about this internal +format. + +=cut + +sub jd { + my $self = shift; + + if ( my $jd = shift ) { + ( $self->{julian}, $self->{julsec} ) = @$jd; + } + + return [ $self->{julian}, $self->{julsec} ]; +} + +sub julian { return jd(@_) } + +# INTERNAL ONLY: figures out what the UTC offset (in HHMM) is +# is for the current machine. +sub _calc_local_offset { + + use Time::Local; + my @t = gmtime; + + my $local = timelocal(@t); + my $gm = timegm(@t); + + my $secdiff = $gm - $local; + return offset_from_seconds($secdiff); +} + +#}}} + +1; + +# More docs {{{ + +=head1 TODO + +=over 4 + +=item - add gmtime and localtime methods, perhaps? + +=item - Fix the INTERNALS file so that it actually reflects reality + +=back + +=head1 INTERNALS + +Please see the file INTERNALS for discussion on the internals. + +=head1 AUTHOR + +Rich Bowen (DrBacchus) rbowen@rcbowen.com + +And the rest of the Reefknot team. See the source for a full +list of patch contributors and version-by-version notes. + +=head1 SEE ALSO + +datetime@perl.org mailing list + +http://datetime.perl.org/ + +Time::Local + +Net::ICal + +=cut + +#}}} + diff --git a/lib/Date/ICal/Duration.pm b/lib/Date/ICal/Duration.pm new file mode 100644 index 0000000..ceed72a --- /dev/null +++ b/lib/Date/ICal/Duration.pm @@ -0,0 +1,566 @@ +package Date::ICal::Duration; + +use strict; +use Carp; + +use vars qw($VERSION ); +$VERSION = (qw'$Revision: 1.61 $')[1]; + +# Documentation {{{ + +=head1 NAME + +Date::ICal::Duration - durations in iCalendar format, for math purposes. + +=head1 VERSION + +$Revision: 1.61 $ + +=head1 SYNOPSIS + + use Date::ICal::Duration; + + $d = Date::ICal::Duration->new( ical => '-P1W3DT2H3M45S' ); + + $d = Date::ICal::Duration->new( weeks => 1, + days => 1, + hours => 6, + minutes => 15, + seconds => 45); + + # a one hour duration, without other components + $d = Date::ICal::Duration->new( seconds => "3600"); + + # Read-only accessors: + $d->weeks; + $d->days; + $d->hours; + $d->minutes; + $d->seconds; + $d->sign; + + # TODO: Resolve sign() discussion from rk-devel and update synopsis. + + $d->as_seconds (); # returns just seconds + $d->as_elements (); # returns a hash of elements, like the accessors above + $d->as_ical(); # returns an iCalendar duration string + +=head1 DESCRIPTION + +This is a trivial class for representing duration objects, for doing math +in Date::ICal + +=head1 AUTHOR + +Rich Bowen, and the Reefknot team. Alas, Reefknot is no more. See +http://datetime.perl.org/ for more modern modules. + +Last touched by $Author: rbowen $ + +=head1 METHODS + +Date::ICal::Duration has the following methods available: + +=head2 new + +A new Date::ICal::Duration object can be created with an iCalendar string : + + my $ical = Date::ICal::Duration->new ( ical => 'P3W2D' ); + # 3 weeks, 2 days, positive direction + my $ical = Date::ICal::Duration->new ( ical => '-P6H3M30S' ); + # 6 hours, 3 minutes, 30 seconds, negative direction + +Or with a number of seconds: + + my $ical = Date::ICal::Duration->new ( seconds => "3600" ); + # one hour positive + +Or, better still, create it with components + + my $date = Date::ICal::Duration->new ( + weeks => 6, + days => 2, + hours => 7, + minutes => 15, + seconds => 47, + sign => "+" + ); + +The sign defaults to "+", but "+" and "-" are legal values. + +=cut + +#}}} + +#{{{ sub new + +sub new { + my ($class, %args) = @_; + my $verified = {}; + my $self = {}; + bless $self, $class; + + my $seconds_only = 1; # keep track of whether we were given length in seconds only + $seconds_only = 0 unless (defined $args{'seconds'}); + + # If one of the attributes is negative, then they all must be + # negative. Otherwise, we're not sure what this means. + foreach (qw(hours minutes seconds days weeks)) { + if (defined($args{$_}) ) { + # make sure this argument is all digits, optional - sign + if ($args{$_} =~ m/-?[0-9]+$/) { + if ($args{$_} < 0) { + $args{sign} = '-'; + $args{$_} = abs($args{$_}); + } + $verified->{$_} = $args{$_}; + unless ($_ eq 'seconds') { + $seconds_only = 0; + } + } else { + carp ("Parameter $_ contains non-numeric value " . $args{$_} . "\n"); + } + } + } + + if (defined ($args{sign}) ) { + + # make sure this argument + or - + if ($args{sign} =~ m/[+-]/) { + # if so, assign it + $self->{sign} = ($args{sign} eq "+") ? 1 : -1; + $verified->{sign} = ($args{sign} eq "+") ? '+' : '-'; + } else { + carp ("Parameter sign contains a value other than + or - : " + . $args{sign} . "\n"); + } + + } + + # If a number is given, convert it to hours, minutes, and seconds, + # but *don't* extract days -- we want it to represent an absolute + # amount of time, regardless of timezone + if ($seconds_only) { # if we were given an integer time_t + $self->_set_from_seconds($args{'seconds'}); + } elsif (defined ($args{'ical'}) ) { + # A standard duration string + #warn "setting from ical\n"; + $self->_set_from_ical($args{'ical'}); + } elsif (not $seconds_only) { + #warn "setting from components"; + #use Data::Dumper; warn Dumper $verified; + $self->_set_from_components($verified); + } + + return undef unless %args; + + return $self; +} + +#}}} + +# Accessors {{{ + +=head2 sign, weeks, days, hours, minutes, seconds + +Read-only accessors for the elements of the object. + +=cut + +#}}} + +# {{{ sub sign + +sub sign { + my ($self) = @_; + return $self->{sign}; +} + +#}}} + +# {{{ sub weeks + +sub weeks { + my ($self) = @_; + my $w = ${$self->_wd}[0]; + return unless $w; + return $self->{sign} * $w; +} + +#}}} + +# {{{ sub days + +sub days { + my ($self) = @_; + my $d = ${$self->_wd}[1]; + return unless $d; + return $self->{sign} * $d; + +} #}}} + +#{{{ sub hours + +sub hours { + my ($self) = @_; + my $h = ${$self->_hms}[0]; + return unless $h; + return $self->{sign} * $h; +} + +#}}} + +# {{{ sub minutes + +sub minutes { + my ($self) = @_; + my $m = ${$self->_hms}[1]; + return unless $m; + return $self->{sign} * $m; +} + +#}}} + +# {{{ sub seconds + +sub seconds { + my ($self) = @_; + my $s = ${$self->_hms}[2]; + return unless $s; + return $self->{sign} * $s; +} + +#}}} + +# sub as_seconds {{{ + +=head2 as_seconds + +Returns the duration in raw seconds. + +WARNING -- this folds in the number of days, assuming that they are always 86400 +seconds long (which is not true twice a year in areas that honor daylight +savings time). If you're using this for date arithmetic, consider using the +I method from a L object, as this will behave better. +Otherwise, you might experience some error when working with times that are +specified in a time zone that observes daylight savings time. + + +=cut + +sub as_seconds { + my ($self) = @_; + + my $nsecs = $self->{nsecs} || 0; + my $ndays = $self->{ndays} || 0; + my $sign = $self->{sign} || 1; + return $sign*($nsecs+($ndays*24*60*60)); +} + +#}}} + +# sub as_days {{{ + +=head2 as_days + + $days = $duration->as_days; + +Returns the duration as a number of days. Not to be confused with the +C method, this method returns the total number of days, rather +than mod'ing out the complete weeks. Thus, if we have a duration of 33 +days, C will return 4, C will return 5, but C will +return 33. + +Note that this is a lazy convenience function which is just weeks*7 + +days. + +=cut + +sub as_days { + my ($self) = @_; + my $wd = $self->_wd; + return $self->{sign} * ( $wd->[0]*7 + $wd->[1] ); +}# }}} + +#{{{ sub as_ical + +=head2 as_ical + +Return the duration in an iCalendar format value string (e.g., "PT2H0M0S") + +=cut + +sub as_ical { + my ($self) = @_; + + my $tpart = ''; + + if (my $ar_hms = $self->_hms) { + $tpart = sprintf('T%dH%dM%dS', @$ar_hms); + } + + my $ar_wd = $self->_wd(); + + my $dpart = ''; + if (defined $ar_wd) { + my ($weeks, $days) = @$ar_wd; + if ($weeks && $days) { + $dpart = sprintf('%dW%dD', $weeks, $days); + } elsif ($weeks) { # (if days = 0) + $dpart = sprintf('%dW', $weeks); + } else { + $dpart = sprintf('%dD', $days); + } + } + + # put a sign in the return value if necessary + my $value = join('', (($self->{sign} < 0) ? '-' : ''), + 'P', $dpart, $tpart); + + # remove any zero components from the time string (-P10D0H -> -P10D) + $value =~ s/(?<=[^\d])0[WDHMS]//g; + + # return either the time value or PT0S (if the time value is zero). + return (($value !~ /PT?$/) ? $value : 'PT0S'); +} + +#}}} + +#{{{ sub as_elements + +=head2 as_elements + +Returns the duration as a hashref of elements. + +=cut + +sub as_elements { + my ($self) = @_; + + # get values for all the elements + my $wd = $self->_wd; + my $hms = $self->_hms; + + my $return = { + sign => $self->{sign}, + weeks => ${$wd}[0], + days => ${$wd}[1], + hours => ${$hms}[0], + minutes => ${$hms}[1], + seconds => ${$hms}[2], + }; + return $return; +} + +#}}} + +# INTERNALS {{{ + +=head1 INTERNALS + +head2 GENERAL MODEL + +Internally, we store 3 data values: a number of days, a number of seconds (anything +shorter than a day), and a sign (1 or -1). We are assuming that a day is 24 hours for +purposes of this module; yes, we know that's not completely accurate because of +daylight-savings-time switchovers, but it's mostly correct. Suggestions are welcome. + +NOTE: The methods below SHOULD NOT be relied on to stay the same in future versions. + +=head2 _set_from_ical ($self, $duration_string) + +Converts a RFC2445 DURATION format string to the internal storage format. + +=cut + +#}}} + +# sub _set_from_ical (internal) {{{ + +sub _set_from_ical { + my ($self, $str) = @_; + + my $parsed_values = _parse_ical_string($str); + + return $self->_set_from_components($parsed_values); +} # }}} + +# sub _parse_ical_string (internal) {{{ + +=head2 _parse_ical_string ($string) + +Regular expression for parsing iCalendar into usable values. + +=cut + +sub _parse_ical_string { + my ($str) = @_; + + # RFC 2445 section 4.3.6 + # + # dur-value = (["+"] / "-") "P" (dur-date / dur-time / dur-week) + # dur-date = dur-day [dur-time] + # dur-time = "T" (dur-hour / dur-minute / dur-second) + # dur-week = 1*DIGIT "W" + # dur-hour = 1*DIGIT "H" [dur-minute] + # dur-minute = 1*DIGIT "M" [dur-second] + # dur-second = 1*DIGIT "S" + # dur-day = 1*DIGIT "D" + + my ($sign_str, $magic, $weeks, $days, $hours, $minutes, $seconds) = + $str =~ m{ + ([\+\-])? (?# Sign) + (P) (?# 'P' for period? This is our magic character) + (?: + (?:(\d+)W)? (?# Weeks) + (?:(\d+)D)? (?# Days) + )? + (?:T (?# Time prefix) + (?:(\d+)H)? (?# Hours) + (?:(\d+)M)? (?# Minutes) + (?:(\d+)S)? (?# Seconds) + )? + }x; + + if (!defined($magic)) { + carp "Invalid duration: $str"; + return undef; + } + + # make sure the sign gets set, and turn it into an integer multiplier + $sign_str ||= "+"; + my $sign = ($sign_str eq "-") ? -1 : 1; + + my $return = {}; + $return->{'weeks'} = $weeks; + $return->{'days'} = $days; + $return->{'hours'} = $hours; + $return->{'minutes'} = $minutes; + $return->{'seconds'} = $seconds; + $return->{'sign'} = $sign; + + return $return; +} # }}} + +# sub _set_from_components (internal) {{{ + +=head2 _set_from_components ($self, $hashref) + +Converts from a hashref to the internal storage format. +The hashref can contain elements "sign", "weeks", "days", "hours", "minutes", "seconds". + +=cut + +sub _set_from_components { + my ($self, $args) = @_; + + # Set up some easier-to-read variables + my ($sign, $weeks, $days, $hours, $minutes, $seconds); + $sign = $args->{'sign'}; + $weeks = $args->{'weeks'}; + $days = $args->{'days'}; + $hours = $args->{'hours'}; + $minutes = $args->{'minutes'}; + $seconds = $args->{'seconds'}; + + $self->{sign} = (defined($sign) && $sign eq '-') ? -1 : 1; + + if (defined($weeks) or defined($days)) { + $self->_wd([$weeks || 0, $days || 0]); + } + + if (defined($hours) || defined($minutes) || defined($seconds)) { + $self->_hms([$hours || 0, $minutes || 0, $seconds || 0]); + } + + return $self; +} # }}} + +# sub _set_from_ical (internal) {{{ + +=head2 _set_from_ical ($self, $num_seconds) + +Sets internal data storage properly if we were only given seconds as a parameter. + +=cut + +sub _set_from_seconds { + my ($self, $seconds) = @_; + + $self->{sign} = (($seconds < 0) ? -1 : 1); + # find the number of days, if any + my $ndays = int ($seconds / (24*60*60)); + # now, how many hours/minutes/seconds are there, after + # days are taken out? + my $nsecs = $seconds % (24*60*60); + $self->{ndays} = abs($ndays); + $self->{nsecs} = abs($nsecs); + + + return $self; +} # }}} + +# sub _hms (internal) {{{ + +=head2 $self->_hms(); + +Return an arrayref to hours, minutes, and second components, or undef +if nsecs is undefined. If given an arrayref, computes the new nsecs value +for the duration. + +=cut + +sub _hms { + my ($self, $hms_arrayref) = @_; + + if (defined($hms_arrayref)) { + my $new_sec_value = $hms_arrayref->[0]*3600 + + $hms_arrayref->[1]*60 + $hms_arrayref->[2]; + $self->{nsecs} = ($new_sec_value); + } + + my $nsecs = $self->{nsecs}; + if (defined($nsecs)) { + my $hours = int($nsecs/3600); + my $minutes = int(($nsecs-$hours*3600)/60); + my $seconds = $nsecs % 60; + return [ $hours, $minutes, $seconds ]; + } else { + print "returning undef\n"; + return undef; + } +} # }}} + +# sub _wd (internal) {{{ + +=head2 $self->_wd() + +Return an arrayref to weeks and day components, or undef if ndays +is undefined. If Given an arrayref, computs the new ndays value +for the duration. + +=cut + +sub _wd { + my ($self, $wd_arrayref) = @_; + + #print "entering _wd\n"; + + if (defined($wd_arrayref)) { + + my $new_ndays = $wd_arrayref->[0]*7 + $wd_arrayref->[1]; + $self->{ndays} = $new_ndays; + } + + #use Data::Dumper; print Dumper $self->{ndays}; + + if (defined(my $ndays= $self->{ndays})) { + my $weeks = int($ndays/7); + my $days = $ndays % 7; + return [ $weeks, $days ]; + } else { + return undef; + } +} # }}} + +1; diff --git a/t/00load.t b/t/00load.t new file mode 100644 index 0000000..ce2aa7f --- /dev/null +++ b/t/00load.t @@ -0,0 +1,6 @@ +use Test::More qw(no_plan); + +# Check to see if it loads + +BEGIN{ use_ok( 'Date::ICal' ); } + diff --git a/t/01sanity.t b/t/01sanity.t new file mode 100644 index 0000000..6c21cf1 --- /dev/null +++ b/t/01sanity.t @@ -0,0 +1,70 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.pl' + +use Test::More qw(no_plan); + +BEGIN { use_ok('Date::ICal') }; + +#====================================================================== +# BASIC INITIALIZATION TESTS +#====================================================================== + +my $t1 = new Date::ICal( epoch => 0 ); +is( $t1->epoch, 0, "Epoch time of 0" ); + +# Make sure epoch time is being handled sanely. +# FIXME: This will only work on unix systems. +is( $t1->ical, '19700101Z', "When does the epoch start?" ); + +is( $t1->year, 1970, "Year accessor, start of epoch" ); +is( $t1->month, 1, "Month accessor, start of epoch" ); +is( $t1->day, 1, "Day accessor, start of epoch" ); + +# like the tests above, but starting with ical instead of epoch +my $t2 = new Date::ICal( ical => '19700101Z' ); +is( $t2->ical, '19700101Z', "Start of epoch in ICal notation" ); + +# NOTE: this will FAIL unless you are in a UTC timezone. +is( $t2->epoch, 0, "Time should be stored in UTC anyway, right?" ); + +# Dates in December are giving a month of 0. Test for this +my $dec = Date::ICal->new( ical => '19961222Z' ); +is( $dec->month, 12, 'Date should be in December' ); +$dec->add( week => 4 ); +is( $dec->month, 1, '4 weeks later, it is January' ); + +#====================================================================== +# ACCESSOR READ TESTS +#====================================================================== + +my $t3 = new Date::ICal( ical => "20010203T183020Z" ); + +is( $t3->year, 2001, "Year accessor" ); +is( $t3->month, 2, "Month accessor" ); +is( $t3->day, 3, "Day accessor" ); +is( $t3->hour, 18, "Hour accessor" ); +is( $t3->minute, 30, "Minute accessor" ); +is( $t3->second, 20 || $t3->second == 19, "Second accessor" ); + +# XXX Round-off error + +# TODO: test the timezone accessor, when there is one + +#====================================================================== +# ACCESSOR WRITE TESTS +#====================================================================== + +my $t4 = new Date::ICal( ical => "18701021T121045Z" ); +is( $t4->year, '1870', "Year accessor, outside of the epoch" ); +is( $t4->month, '10', "Month accessor, outside the epoch" ); +is( $t4->day, '21', "Day accessor, outside the epoch" ); +is( $t4->hour, '12', "Hour accessor, outside the epoch" ); +is( $t4->minute, '10', "Minute accessor, outside the epoch" ); +is( $t4->second, '45', "Second accessor, outside the epoch" ); + +# OTHER TESTS WE NEED, once the code supports them: +# - timezone testing +# - UTC <-> localtime +# - arithmetic, with and without unit rollovers + + diff --git a/t/02normalize.t b/t/02normalize.t new file mode 100644 index 0000000..f2b132b --- /dev/null +++ b/t/02normalize.t @@ -0,0 +1,43 @@ +use Test::More qw(no_plan); + +BEGIN { use_ok( 'Date::ICal' ) } + +# XXX Can't add months, years yet. + +use Date::ICal; + +my $t = Date::ICal->new( ical => '19961122T183020Z' ); + +# Add 2 months +# $t->add( month => 2); + +#test 1 check year rollover works +# ok($t->year,1997); +#test 2 check month set on year rollover +# ok($t->month,1); + +# $t->add( week => 2 ); + +#test 3 & 4 check year/month rollover with attrib setting +# $t->month(14); +# ok($t->year,1998); +# ok($t->month,2); + +#test 5 & 6 test subtraction with attrib setting +# $t->month(-2); +# ok($t->year,1997); +# ok($t->month,10); + +$t->add( day => 1 ); +is( $t->day, 23, 'Add one day' ); + +$t->add( week => 1 ); +is( $t->day, 30, 'Add a week' ); + +$t->add( hour => 3 ); +is( $t->hour, 21, 'Add 3 hours' ); + +$t->add( day => 15 ); +is( $t->month, 12, "2 weeks later, it is December" ); +is( $t->day, 15, "December 15th to be precise" ); + diff --git a/t/03components.t b/t/03components.t new file mode 100644 index 0000000..06c188e --- /dev/null +++ b/t/03components.t @@ -0,0 +1,15 @@ +use Test::More qw(no_plan); + +BEGIN { + use_ok( 'Date::ICal' ); +} + +my $d = Date::ICal->new( year => 2001, month => 7, day => 5, offset => 0 ); +is( $d->year, 2001, "Year, creation by components" ); +is( $d->month, 7, "Month, creation by components" ); +is( $d->day, 5, "Day, creation by components" ); +is( $d->hour, 0, "Hour, creation by components" ); +is( $d->min, 0, "Min, creation by components" ); +is( $d->sec, 0, "Sec, creation by components" ); +is( $d->ical, '20010705Z', "ical, creation by components" ); + diff --git a/t/04epoch.t b/t/04epoch.t new file mode 100644 index 0000000..eb37e5b --- /dev/null +++ b/t/04epoch.t @@ -0,0 +1,36 @@ +use Test::More qw(no_plan); + +BEGIN{ use_ok('Date::ICal'); } + +# Tests creating objects from epoch time + +my $t1 = Date::ICal->new( epoch => 0, offset => 0 ); +is( $t1->epoch(), '0', 'creation test from epoch (compare to epoch)' ); +is( $t1->ical(), '19700101Z', 'creation test from epoch (compare to ical)' ); + +is( $t1->second, 0, "seconds are correct on epoch 0" ); +is( $t1->minute, 0, "minutes are correct on epoch 0" ); +is( $t1->hour, 0, "hours are correct on epoch 0" ); +is( $t1->day, 1, "days are correct on epoch 0" ); +is( $t1->month, 1, "months are correct on epoch 0" ); +is( $t1->year, 1970, "year is correct on epoch 0" ); + +$t1 = Date::ICal->new( epoch => '3600' ); +is( $t1->epoch, 3600, 'creation test from epoch = 3600 (compare to epoch)' ); +is( $t1->ical, '19700101T010000Z', + 'creation test from epoch (compare to ical = 19700101T010000Z)' ); + +my $now = time; +my $nowtest = Date::ICal->new( offset => 0 ); +my $nowtest2 = Date::ICal->new( epoch => $now, offset => 0 ); +is( $nowtest->hour, $nowtest2->hour, "Hour: Create without args" ); +is( $nowtest->month, $nowtest2->month, "Month : Create without args" ); +is( $nowtest->minute, $nowtest2->minute, "Minute: Create without args" ); + +my $epochtest = Date::ICal->new( epoch => '997122970', offset => 0 ); +is( $epochtest->epoch(997121000), 997121000, + "Setting epoch returns correct value" ); +is( $epochtest->epoch, 997121000, "And the value stuck" ); +is( $epochtest->hour, 18, "Hour, after setting epoch" ); +is( $epochtest->min, 3, "Min, after setting epoch" ); + diff --git a/t/05ical.t b/t/05ical.t new file mode 100644 index 0000000..46b61db --- /dev/null +++ b/t/05ical.t @@ -0,0 +1,28 @@ +use Test::More qw(no_plan); + +BEGIN{use_ok('Date::ICal')} + +# Testing object creation with ical string + +my $acctest = Date::ICal->new( ical => "19920405T160708Z" ); + +is( $acctest->sec, 8, "second accessor read is correct" ); +is( $acctest->minute, 7, "minute accessor read is correct" ); +is( $acctest->hour, 16, "hour accessor read is correct" ); +is( $acctest->day, 5, "day accessor read is correct" ); +is( $acctest->month, 4, "month accessor read is correct" ); +is( $acctest->year, 1992, "year accessor read is correct" ); + +# extra-epoch dates? + +my $preepoch = Date::ICal->new( ical => '18700523T164702Z' ); +is( $preepoch->year, 1870, 'Pre-epoch year' ); +is( $preepoch->month, 5, 'Pre-epoch month' ); +is( $preepoch->sec, 2, 'Pre-epoch seconds' ); + +my $postepoch = Date::ICal->new( ical => '23481016T041612Z' ); +is( $postepoch->year, 2348, "Post-epoch year" ); +is( $postepoch->day, 16, "Post-epoch day" ); +is( $postepoch->hour, 04, "Post-epoch hour" ); + + diff --git a/t/06add.t b/t/06add.t new file mode 100644 index 0000000..31de160 --- /dev/null +++ b/t/06add.t @@ -0,0 +1,210 @@ +use Test::More qw(no_plan); + +BEGIN { use_ok ('Date::ICal'); } + +my $t = Date::ICal->new( ical => '19961122T183020Z' ); +$t->add( week => 8 ); + +is( $t->year, 1997, "year rollover" ); +is( $t->month, 1, "month set on year rollover" ); +is( $t->ical, '19970117T183020Z', 'ical is okay on year rollover' ); + +$t->add( week => 2 ); +is( $t->ical, '19970131T183020Z', 'Adding weeks as attribute' ); + +$t->add( sec => 15 ); +is( $t->ical, '19970131T183035Z', 'Adding seconds as attribute' ); + +$t->add( min => 12 ); +is( $t->ical, '19970131T184235Z', 'Adding minutes as attribute' ); + +$t->add( min => 25, hour => 3, sec => 7 ); +is( $t->ical, '19970131T220742Z', 'Adding h,m,s as attributes' ); + +# Now, test the adding of durations +$t = Date::ICal->new( ical => '19860128T163800Z' ); + +$t->add( duration => 'PT1M12S' ); +is( $t->ical, '19860128T163912Z', + "Adding durations with minutes and seconds works" ); + +$t = Date::ICal->new( ical => '19860128T163800Z' ); + +$t->add( duration => 'PT30S' ); +is( $t->ical, '19860128T163830Z', "Adding durations with seconds only works" ); + +$t = Date::ICal->new( ical => '19860128T163800Z' ); + +$t->add( duration => 'PT1H10M' ); +is( $t->ical, '19860128T174800Z', + "Adding durations with hours and minutes works" ); + + +$t = Date::ICal->new( ical => '19860128T163800Z' ); + +$t->add( duration => 'P3D' ); + +# XXX: what is "right" in the following test? should the result +# just be a date, or a date and time? +is( $t->ical, '19860131T163800Z', "Adding durations with days only works" ); + +$t = Date::ICal->new( ical => '19860128T163800Z' ); + +$t->add( duration => 'P3DT2H' ); +is( $t->ical, '19860131T183800Z', + "Adding durations with days and hours works" ); + +$t = Date::ICal->new( ical => '19860128T163800Z' ); + +$t->add( duration => 'P3DT2H20M15S' ); +is( $t->ical, '19860131T185815Z', + "Adding durations with days, hours, minutes, and seconds works" ); + +# Add 15M - this test failed at one point in N::I::Time +$t = Date::ICal->new( ical => '20010405T160000Z' ); +$t->add( duration => 'PT15M' ); +is( $t->ical, '20010405T161500Z', "Adding minutes to an ical string" ); + +# Subtract a duration +$t->add( duration => '-PT15M' ); +is( $t->ical, '20010405T160000Z', "Back where we started" ); + +undef $t; + +$t = Date::ICal->new( ical => '19860128T163800Z' ); +$t->add( seconds => '60' ); +is( $t->ical, "19860128T163900Z", + "adding positive seconds with seconds works" ); +$t->add( seconds => '-120' ); +is( $t->ical, "19860128T163700Z", + "adding negative seconds with seconds works" ); + +# test sub months +$t = Date::ICal->new( ical => '20010131Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010201Z', 'february 1st' ); +$t = Date::ICal->new( ical => '20010228Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010301Z', 'march 1st' ); +$t = Date::ICal->new( ical => '20010331Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010401Z', 'april 1st' ); +$t = Date::ICal->new( ical => '20010430Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010501Z', 'may 1st' ); +$t = Date::ICal->new( ical => '20010531Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010601Z', 'june 1st' ); +$t = Date::ICal->new( ical => '20010630Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010701Z', 'july 1st' ); +$t = Date::ICal->new( ical => '20010731Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010801Z', 'august 1st' ); +$t = Date::ICal->new( ical => '20010831Z' ); +$t->add( day => 1 ); +is( $t->ical, '20010901Z', 'september 1st' ); +$t = Date::ICal->new( ical => '20010930Z' ); +$t->add( day => 1 ); +is( $t->ical, '20011001Z', 'october 1st' ); +$t = Date::ICal->new( ical => '20011031Z' ); +$t->add( day => 1 ); +is( $t->ical, '20011101Z', 'november 1st' ); +$t = Date::ICal->new( ical => '20011130Z' ); +$t->add( day => 1 ); +is( $t->ical, '20011201Z', 'december 1st' ); +$t = Date::ICal->new( ical => '20011231Z' ); +$t->add( day => 1 ); +is( $t->ical, '20020101Z', 'january 1st' ); + +# Adding years + +# Before leap day, not a leap year ... +$t = Date::ICal->new( ical => '20010228Z' ); +$t->add( year => 1 ); +is( $t->ical, '20020228Z', 'Adding a year' ); +$t->add( year => 17 ); +is( $t->ical, '20190228Z', 'Adding 17 years' ); + +# After leap day, not a leap year ... +$t = Date::ICal->new( ical => '20010328Z' ); +$t->add( year => 1 ); +is( $t->ical, '20020328Z', 'Adding a year' ); +$t->add( year => 17 ); +is( $t->ical, '20190328Z', 'Adding 17 years' ); + +# On leap day, in a leap year ... +$t = Date::ICal->new( ical => '20000229Z' ); +$t->add( year => 1 ); +is( $t->ical, '20010301Z', 'Adding a year' ); +$t->add( year => 17 ); +is( $t->ical, '20180301Z', 'Adding 17 years' ); + +# Before leap day, in a leap year ... +$t = Date::ICal->new( ical => '20000228Z' ); +$t->add( year => 1 ); +is( $t->ical, '20010228Z', 'Adding a year' ); +$t->add( year => 17 ); +is( $t->ical, '20180228Z', 'Adding 17 years' ); + +# After leap day, in a leap year ... +$t = Date::ICal->new( ical => '20000328Z' ); +$t->add( year => 1 ); +is( $t->ical, '20010328Z', 'Adding a year' ); +$t->add( year => 17 ); +is( $t->ical, '20180328Z', 'Adding 17 years' ); + +# Test a bunch of years, before leap day +for ( 1 .. 99 ) { + $t = Date::ICal->new( ical => '20000228Z' ); + $t->add( year => $_ ); + my $x = sprintf '%02d', $_; + is( $t->ical, '20' . $x . '0228Z', "Adding $_ years" ); +} + +# Test a bunch of years, after leap day +for ( 1 .. 99 ) { + $t = Date::ICal->new( ical => '20000328Z' ); + $t->add( year => $_ ); + my $x = sprintf '%02d', $_; + is( $t->ical, '20' . $x . '0328Z', "Adding $_ years" ); +} + +# And more of the same, starting on a non-leap year + +# Test a bunch of years, before leap day +for ( 1 .. 97 ) { + $t = Date::ICal->new( ical => '20020228Z' ); + $t->add( year => $_ ); + my $x = sprintf '%02d', $_ + 2; + is( $t->ical, '20' . $x . '0228Z', "Adding $_ years" ); +} + +# Test a bunch of years, after leap day +for ( 1 .. 97 ) { + $t = Date::ICal->new( ical => '20020328Z' ); + $t->add( year => $_ ); + my $x = sprintf '%02d', $_ + 2; + is( $t->ical, '20' . $x . '0328Z', "Adding $_ years" ); +} + +# subtract years +for ( 1 .. 97 ) { + $t = Date::ICal->new( ical => '19990301Z' ); + $t->add( year => -$_ ); + my $x = sprintf '%02d', 99 - $_; + is( $t->ical, '19' . $x . '0301Z', "Subtracting $_ years" ); +} + +# test some old bugs + +# bug adding months where current month + months added were > 25 +$t = Date::ICal::->new(ical=>'19971201Z'); +$t->add( month=>14 ); +is($t->ical, '19990201Z', 'Adding months--rollover year' ); + +# bug subtracting months with year rollover +$t = Date::ICal::->new(ical=>'19970101Z'); +$t->add( month=>-1 ); +is($t->ical, '19961201Z', 'Subtracting months--rollover year'); + diff --git a/t/07compare.t b/t/07compare.t new file mode 100644 index 0000000..d98435f --- /dev/null +++ b/t/07compare.t @@ -0,0 +1,50 @@ +use Test::More qw(no_plan); + +BEGIN { use_ok ('Date::ICal'); } + +my $date1 = Date::ICal->new( ical => '19971024T120000'); +my $date2 = Date::ICal->new( ical => '19971024T120000'); + + +# make sure that comparing to itself eq 0 +my $identity = $date1->compare($date2); +is( $identity, 0, "Identity comparison" ); + +$date2 = Date::ICal->new( ical => '19971024T120001' ); +is( $date1->compare($date2), -1, 'Comparison $a < $b, 1 second diff' ); + +$date2 = Date::ICal->new( ical => '19971024T120100' ); +is( $date1->compare($date2), -1, 'Comparison $a < $b, 1 minute diff' ); + +$date2 = Date::ICal->new( ical => '19971024T130000' ); +is( $date1->compare($date2), -1, 'Comparison $a < $b, 1 hour diff' ); + +$date2 = Date::ICal->new( ical => '19971025T120000' ); +is( $date1->compare($date2), -1, 'Comparison $a < $b, 1 day diff' ); + +$date2 = Date::ICal->new( ical => '19971124T120000' ); +is( $date1->compare($date2), -1, 'Comparison $a < $b, 1 month diff' ); + +$date2 = Date::ICal->new( ical => '19981024T120000' ); +is( $date1->compare($date2), -1, 'Comparison $a < $b, 1 year diff' ); + +# $a > $b tests + +$date2 = Date::ICal->new( ical => '19971024T115959' ); +is( $date1->compare($date2), 1, 'Comparison $a > $b, 1 second diff' ); + +$date2 = Date::ICal->new( ical => '19971024T115900' ); +is( $date1->compare($date2), 1, 'Comparison $a > $b, 1 minute diff' ); + +$date2 = Date::ICal->new( ical => '19971024T110000' ); +is( $date1->compare($date2), 1, 'Comparison $a > $b, 1 hour diff' ); + +$date2 = Date::ICal->new( ical => '19971023T120000' ); +is( $date1->compare($date2), 1, 'Comparison $a > $b, 1 day diff' ); + +$date2 = Date::ICal->new( ical => '19970924T120000' ); +is( $date1->compare($date2), 1, 'Comparison $a > $b, 1 month diff' ); + +$date2 = Date::ICal->new( ical => '19961024T120000' ); +is( $date1->compare($date2), 1, 'Comparison $a > $b, 1 year diff' ); + diff --git a/t/08offset.t b/t/08offset.t new file mode 100644 index 0000000..735c72c --- /dev/null +++ b/t/08offset.t @@ -0,0 +1,105 @@ +use Test::More qw(no_plan); + +BEGIN{ use_ok('Date::ICal'); } + +# Tests creating objects from GMT + +my $t1 = Date::ICal->new(epoch => '0'); +ok ($t1->epoch() eq '0', 'creation test from epoch (compare to epoch)'); +ok ($t1->ical() eq '19700101Z', 'creation test from epoch (compare to ical)'); + +ok ($t1->offset() eq '0', 'offset is 0 by default'); + +is ($t1->offset('+0100'), '+0100', + 'setting offset positive returns correct value'); + +is ($t1->ical, '19691231T230000Z', 'offset set correctly with positive value'); + + +#----------------------------------------------------------------------------- +# some internals tests +is(Date::ICal::offset_from_seconds(0), 0, + "offset_from_seconds does the right thing on 0"); +is(Date::ICal::offset_from_seconds(3600), "+0100", + "offset_from_seconds works on positive whole hours"); +is(Date::ICal::offset_from_seconds(-3600), "-0100", + "offset_from_seconds works on negative whole hours"); +is(Date::ICal::offset_from_seconds(5400), "+0130", + "offset_from_seconds works on positive half hours"); +is(Date::ICal::offset_from_seconds(-5400), "-0130", + "offset_from_seconds works on negative half hours"); + +is(Date::ICal::offset_from_seconds(20700), "+0545", + "offset_from_seconds works on positive 15min zones"); +is(Date::ICal::offset_from_seconds(-20700), "-0545", + "offset_from_seconds works on negative 15min zones"); + +is(Date::ICal::offset_from_seconds(86400), "+0000", + "offset_from_seconds rolls over properly on one full day of seconds"); +is(Date::ICal::offset_from_seconds(86400 + 3600), "+0100", + "offset_from_seconds rolls over properly on one day + 1 hour of seconds"); + +# Need to write tests and code to handle bogus data gracefully. +# For example, what if someone tells us they have an offset +# of 5 minutes and 30 seconds? Do we return 0005, 0006, or 0, and how +# loudly do we carp? + +#----------------------------------------------------------------------------- +{ +my $warn=""; +local $SIG{__WARN__} = sub { $warn .= join('',@_); }; + +ok (!defined $t1->offset('hullaballo'), 'offset rejects bad args'); +is ($t1->offset, '+0100', 'without changing the offset'); +ok (scalar($warn =~ /^You gave an offset, hullaballo, that makes no sense/), + 'and with a warning'); +} + +is ($t1->offset('-0100'), '-0100', + 'setting offset negative returns correct value'); + +is($t1->ical, '19700101T010000Z', 'offset set correctly with negative value'); + +$t1->offset(0); +is($t1->ical, '19700101Z', 'offset can be reset to zero seconds'); + +# The offset should not get set here because of the Z +my $t2 = Date::ICal->new(ical => '20020405T120000Z', offset => '-0400'); + +is($t2->offset(), '0', 'UTC in ical ending with Z overrides offset'); + +# TODO: write tests here that test date/time output of an +# offset-valued time + +undef $t2; +my $loctime = '20020405T120000'; +my $utctime = '20020405T200000Z'; +$t2 = Date::ICal->new(ical => $loctime, offset => '-0800'); +ok(defined($t2), + "new object with localtime ical and an offset returns a defined value"); + +is($t2->offset(), '-0800', "offset() returns negative offsets correctly"); + +ok($t2->ical() =~ /Z$/, "Default ical() output is in UTC"); +is($t2->ical(), $utctime, + "Default ical() output in UTC is correct when an object is initialized with an offset"); + +is($t2->ical( localtime => 1 ), $loctime, + "Localtime ical( localtime => 1 ) output is correct"); + +is($t2->ical(), $utctime, + "Default ical() output in UTC is correct after localtime access made"); + +undef $t2; +$t2 = Date::ICal->new(ical => '20020405T120000', offset => '+0800'); +is($t2->offset(), '+0800', "offset() returns positive offsets correctly"); +# TODO: test ical output on that object + +undef $t2; +$t2 = Date::ICal->new(ical => '20020405T120000', offset => '+0545'); +is($t2->offset(), '+0545', "offset() returns fractional-hour offsets correctly"); +# TODO: test ical output from this object + +# TODO: test the offset method's ways of being called: make sure it can +# tell the difference between being called like offset("+0100") and +# offset("3700"). diff --git a/t/09greg.t b/t/09greg.t new file mode 100644 index 0000000..aae038e --- /dev/null +++ b/t/09greg.t @@ -0,0 +1,90 @@ +use Test::More qw(no_plan); + +BEGIN { use_ok('Date::ICal') }; + +my $harness = $ENV{HARNESS_ACTIVE}; +$|=1 unless $harness; + +# test greg2jd and jd2greg for various dates +# 2 tests are performed for each date (on greg2jd and jd2greg) +# dates are specified as [jd,year,month,day] +for ( + # min and max supported days (for 32-bit system) + [-2**31,-5879610,6,22],[2**31-1,5879611,7,11], + + # some miscellaneous dates I had day numbers for (these are + # actually epoch dates for various calendars from Calendrical + # Calculations (1st ed) Table 1.1) + + [-1721425,-4713,11,24],[-1373427,-3760,9,7],[-1137142,-3113,8,11], + [-1132959,-3101,1,23],[-963099,-2636,2,15],[-1,0,12,30],[1,1,1,1], + [2796,8,8,27],[103605,284,8,29],[226896,622,3,22],[227015,622,7,19], + [654415,1792,9,22],[673222,1844,3,21] +) { + is(join('/',Date::ICal::jd2greg($_->[0])), join('/',@{$_}[1..3]), + $_->[0]." \t=> ".join'/',@{$_}[1..3]); + is(Date::ICal::greg2jd(@{$_}[1..3]), $_->[0], + join('/',@{$_}[1..3])." \t=> ".$_->[0]); +} + +# normalization tests +for ( + [-1753469,-4797,-33,1],[-1753469,-4803,39,1], + [-1753105,-4796,-34,28],[-1753105,-4802,38,28] +) { + is(Date::ICal::greg2jd(@{$_}[1..3]), $_->[0], + join('/',@{$_}[1..3])." \t=> ".$_->[0]." (normalization)"); +} + +# test first and last day of each month from Jan -4800..Dec 4800 +# this test bails after the first failure with a not ok. +# if it comlpetes successfully, only one ok is issued. + +my @mlen=(0,31,0,31,30,31,30,31,31,30,31,30,31); +my ($dno,$y,$m,$dno2,$y2,$m2,$d2,$mlen) = (-1753530,-4800,1); + +print "# this may take a minute...\n"; +while ( $y <= 4800 ) { + + # test $y,$m,1 + ++$dno; + $dno2 = Date::ICal::greg2jd( $y, $m, 1 ); + if ( $dno != $dno2 ) { + is( $dno2, $dno, "greg torture test: greg2jd($y,$m,1) should be $dno" ); + last; + } + ( $y2, $m2, $d2 ) = Date::ICal::jd2greg($dno); + + if ( $y2 != $y || $m2 != $m || $d2 != 1 ) { + is( "$y2/$m2/$d2", "$y/$m/1", + "greg torture test: jd2greg($dno) should be $y/$m/1" ); + last; + } + + # test $y,$m,$mlen + $mlen = $mlen[$m] || ( $y % 4 ? 28 : $y % 100 ? 29 : $y % 400 ? 28 : 29 ); + $dno += $mlen - 1; + $dno2 = Date::ICal::greg2jd( $y, $m, $mlen ); + if ( $dno != $dno2 ) { + is( $dno2, $dno, + "greg torture test: greg2jd($y,$m,$mlen) should be $dno" ); + last; + } + ( $y2, $m2, $d2 ) = Date::ICal::jd2greg($dno); + + if ( $y2 != $y || $m2 != $m || $d2 != $mlen ) { + is( "$y2/$m2/$d2", "$y/$m/$mlen", + "greg torture test: jd2greg($dno) should be $y/$m/$mlen" ); + last; + } + + # and on to the next month... + if ( ++$m > 12 ) { + $m = 1; + ++$y; + print "\r$y " unless $harness || $y % 100; + } +} +print "\n" unless $harness; +pass("greg torture test") if $y==4801; + diff --git a/t/10subtract.t b/t/10subtract.t new file mode 100644 index 0000000..8d4baae --- /dev/null +++ b/t/10subtract.t @@ -0,0 +1,46 @@ +use Test::More qw(no_plan); + +BEGIN { use_ok('Date::ICal'); } + +my $date1 = Date::ICal->new( ical => '20010510T040302Z' ); +my $date2 = Date::ICal->new( ical => '20010612T050723Z' ); + +my $diff = $date2 - $date1; + +is( $diff->as_days, 33, 'Total # of days' ); +is( $diff->weeks, 4, 'Weeks' ); +is( $diff->days, 5, 'Days' ); +is( $diff->hours, 1, 'Hours' ); +is( $diff->minutes, 4, 'Min' ); +is( $diff->seconds, 21, 'Sec' ); +is( $diff->as_ical, 'P4W5DT1H4M21S', 'Duration' ); + +my $d = Date::ICal->new( ical => '20011019T050101Z' ); +my $dur = 'P1W1DT1H1M1S'; + +my $X = $d - $dur; + +ok( $X, 'Defined' ); +is( $X->ical, '20011011T040000Z', 'Subtract and get the right thing' ); + +my $Y = $d - 'P1W1DT1H1M1S'; +ok( $Y, 'Defined' ); +is( $Y->ical, '20011011T040000Z', 'Subtract and get the right thing' ); + +$date1 = Date::ICal->new( ical => '20010510T040302Z' ); +$date2 = Date::ICal->new( ical => '20010612T050723Z' ); + +$diff = $date1 - $date2; + +is( $diff->as_days, -33, 'Negative duration, days' ); +is( $diff->weeks, -4, 'Weeks' ); +is( $diff->days, -5, 'Days' ); +is( $diff->hours, -1, 'Hours' ); +is( $diff->minutes, -4, 'Min' ); +is( $diff->seconds, -21, 'Sec' ); +is( $diff->as_ical, '-P4W5DT1H4M21S', 'Duration' ); + +$diff = $date1 - $date1; +is( $diff->as_ical, 'PT0S', 'Zero duration' ); +is( $diff->weeks, undef, 'Just checking' ); + diff --git a/t/11duration.t b/t/11duration.t new file mode 100644 index 0000000..6b4b2da --- /dev/null +++ b/t/11duration.t @@ -0,0 +1,162 @@ +use strict; +use Test::More qw(no_plan); + +BEGIN { + use_ok('Date::ICal::Duration'); +} + +# Make sure all the methods we want exist. +ok( Date::ICal::Duration->can('weeks'), "weeks() exists" ); +ok( Date::ICal::Duration->can('days'), "days() exists" ); +ok( Date::ICal::Duration->can('hours'), "hours() exists" ); +ok( Date::ICal::Duration->can('minutes'), "minutes() exists" ); +ok( Date::ICal::Duration->can('seconds'), "seconds() exists" ); + +ok( Date::ICal::Duration->can('as_ical'), "as_ical() exists" ); +ok( Date::ICal::Duration->can('as_seconds'), "as_seconds() exists" ); +ok( Date::ICal::Duration->can('as_elements'), "as_elements() exists" ); + +# Make sure new() traps invalid parameters +my $d = Date::ICal::Duration->new; +is( $d, undef, "new() with no arguments gives undef" ); +undef $d; + +# Test iCalendar string parsing + +sub stringparse_ok { + my ( $param, $expected, $explain ) = @_; + my $parsed_string = Date::ICal::Duration::_parse_ical_string($param); + + # leave the line below in for help in debugging when you need it + #use Data::Dumper; warn Dumper $parsed_string; + + ok( eq_hash( $parsed_string, $expected ), $explain ); +} + +my $str = 'PT1H'; +my $expected = { + sign => 1, + weeks => undef, + days => undef, + hours => 1, + minutes => undef, + seconds => undef +}; + +stringparse_ok( $str, $expected, "string $str parses okay" ); + +$str = 'P3DT1H'; + +# DEVELOPERS: should these be undefs or 0s? Opinions? +$expected = { + sign => 1, + weeks => undef, + days => 3, + hours => 1, + minutes => undef, + seconds => undef +}; + +stringparse_ok( $str, $expected, "string $str parses okay" ); + +# Test iCalendar string parsing +$str = 'P1W2DT3H4M5S'; +$expected = { + sign => 1, + weeks => 1, + days => 2, + hours => 3, + minutes => 4, + seconds => 5 +}; + +stringparse_ok( $str, $expected, "string $str parses okay" ); + +#======================================================================== +# Test creation with seconds only +$d = Date::ICal::Duration->new( seconds => 3600 ); +is( $d->as_seconds, 3600, + "new() with seconds only outputs correctly as_seconds" ); +is( $d->as_ical, 'PT1H', "new() with seconds only outputs correctly as_ical" ); +undef $d; + +# Test creation with seconds and minutes +$d = Date::ICal::Duration->new( seconds => 45, minutes => 2 ); + +is( $d->{nsecs}, 2 * 60 + 45, "Internals: nsecs is being set" ); +is( $d->{ndays}, undef, "Internals: ndays is being set" ); +is( $d->{sign}, 1, "Internals: sign is being set" ); + +is( $d->as_seconds, ( 2 * 60 ) + 45, + "new() with seconds and minutes outputs correctly as_seconds" ); +is( $d->as_ical, 'PT2M45S', + "new() with seconds and minutes outputs correctly as_ical" ); +undef $d; + +# Test creation with ical string +$d = Date::ICal::Duration->new( ical => "PT10H" ); + +ok( defined($d), "Simple creation from ical returns a defined object" ); + +#use Data::Dumper; warn Dumper $d; + +is( $d->{nsecs}, 36000, "Internals: nsecs is being set" ); +is( $d->{ndays}, undef, "Internals: ndays is being set" ); +is( $d->{sign}, 1, "Internals: sign is being set" ); + +is( $d->as_ical, 'PT10H', "Simple creation from ical as_ical" ); +is( $d->as_seconds, 36000, "Simple creation from ical as_seconds" ); + +# test elements and accessors behavior +$d = Date::ICal::Duration->new( ical => "P3W2DT10H30M20S" ); + +is( $d->sign, 1, "sign accessor works " ); +is( $d->weeks, 3, "weeks accessor works " ); +is( $d->days, 2, "days accessor works " ); +is( $d->hours, 10, "hours accessor works " ); +is( $d->minutes, 30, "minutes accessor works " ); +is( $d->seconds, 20, "seconds accessor works " ); + +undef $expected; +$expected = { + sign => 1, + weeks => 3, + days => 2, + hours => 10, + minutes => 30, + seconds => 20 +}; +my $result = $d->as_elements; +ok( eq_hash( $result, $expected ), 'Simple creation from ical as_elements' ); + +# Test reading values with as_elements + +# Test creation with elements + +# Test reading from accessors + +# Make sure accessors cannot set values + +# Test ical output + +# Test seconds output + +# Create a negative duration with components +$d = Date::ICal::Duration->new( + days => -2, + hours => -10, + minutes => -12, + seconds => -14 +); + +is( $d->sign, -1, 'sign is negative' ); +is( $d->days, -2, 'days is still negative' ); +is( $d->hours, -10, 'hours is still negative' ); +is( $d->minutes, -12, 'minutes is still negative' ); +is( $d->seconds, -14, 'seconds is still negative' ); +is( $d->as_ical, '-P2DT10H12M14S', 'Correct duration string' ); + +is( $d->as_days, -2, 'As days' ); +is( $d->as_seconds, -209534, 'As seconds' ); +is( $d->weeks, undef, 'Weeks is undef' ); + -- 2.39.5