From: Michael Howe Date: Sun, 9 Mar 2014 00:32:52 +0000 (+0000) Subject: Import original source of Date-ICal 2.678 X-Git-Tag: upstream/2.678 X-Git-Url: https://git.michaelhowe.org/gitweb/?a=commitdiff_plain;h=0bd5efa0ab37599226f0507a66b4e6396f038dd5;p=packages%2Flibd%2Flibdate-ical-perl.git Import original source of Date-ICal 2.678 --- 0bd5efa0ab37599226f0507a66b4e6396f038dd5 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' ); +