DateTime-Set-0.3900/0000755000175000017500000000000012776373427013350 5ustar fglockfglockDateTime-Set-0.3900/MANIFEST0000644000175000017500000000137312776373427014505 0ustar fglockfglockMANIFEST MANIFEST.SKIP LICENSE Changes TODO README Build.PL Makefile.PL t/00load.t t/01sanity.t t/02immutable.t t/03add_subtract.t t/04recurrence.t t/05iterator.t t/06backtrack.t t/07previous.t t/08span.t t/09spanset.t t/10previous-2.t t/11next.t t/12iterator_intersection.t t/13add_recurrence.t t/14complement.t t/15time_zone.t t/16bounded_recurrence.t t/17quantize.t t/18as_list_empty.t t/19spanset_daylight_savings.t t/20spanset_week_wrapped_recurrence.t t/21from_recurrence.t t/22start_end.t lib/DateTime/Set.pm lib/DateTime/Span.pm lib/DateTime/SpanSet.pm lib/Set/Infinite/_recurrence.pm META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) DateTime-Set-0.3900/MANIFEST.SKIP0000644000175000017500000000025312463127347015235 0ustar fglockfglock^blib/ Makefile.PL t/99-pod.t ^Build ^_build/ ^Makefile$ ^Makefile\.[a-z]+$ ^pm_to_blib$ CVS/.* ,v$ ^tmp/ \.old$ \.bak$ ~$ ^# \.shar$ \.tar$ \.tgz$ \.tar\.gz$ \.zip$ _uu$ DateTime-Set-0.3900/META.yml0000664000175000017500000000117212776373427014624 0ustar fglockfglock--- abstract: 'DateTime set objects' author: - 'Flavio S. Glock ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: DateTime-Set no_index: directory: - t - inc requires: DateTime: '0.12' Params::Validate: '0' Set::Infinite: '0.59' Test::More: '0' resources: repository: https://github.com/fglock/DateTime-Set.git version: '0.3900' DateTime-Set-0.3900/Build.PL0000644000175000017500000000203212776372742014640 0ustar fglockfglockuse strict; use Module::Build; my $build = Module::Build->new( module_name => 'DateTime::Set', dist_name => 'DateTime-Set', dist_author => 'Flavio S. Glock ', dist_abstract => 'DateTime set objects', license => 'perl', requires => { 'DateTime' => 0.12, 'Set::Infinite' => 0.59, 'Test::More' => 0, 'Params::Validate' => 0, }, conflicts => { 'DateTime::Event::Recurrence' => '< 0.10', 'DateTime::Event::ICal' => '< 0.07', 'DateTime::Event::Random' => '< 0.03', 'DateTime::Event::Cron' => '<= 0.06', 'DateTime::Event::Sunrise' => '<= 0.05', # cvs ok; CPAN not ok 'DateTime::Event::Chinese' => '< 0', # untested 'DateTime::Event::Lunar' => '< 0', # untested 'DateTime::Event::SolarTerm' => '< 0', # untested }, # sign => 1, # create_makefile_pl => 'passthrough' ); $build->create_build_script; DateTime-Set-0.3900/Changes0000644000175000017500000003234612776373130014642 0ustar fglockfglockChanges for DateTime::Set 0.3900 2016-10-09 - require Params::Validate 0.3800 2016-05-23 - doc patch, by Lucas Kanashiro. 0.3700 2016-05-17 - end() / max() and start() / min() are aliases to the same method in all classes. Added docs and tests. Reported by Vincent Berger. 0.3600 2015-11-11 - move t/22intersects.t to DT::Event::Recurrence module 0.3500 2015-11-10 - [rt.cpan.org #108633] Recurrent event does not intersect indefinite future, test contributed by Brett Watson. - documentation - intersects() returns 0 for false, and 'undef' for undecidable. 0.3400 2014-02-12 - documentation and packaging fixes - by David Steinbrunner. - version number using 4 digits - requested by David Marshall. 0.33 2013-09-15 - bugfix in SpanSet->grep. Reported by Andreas Isberg 0.32 2013-08-27 - ignore duration signal in DateTime::Span->from_datetime_and_duration() and use the 'end'/'start' parameters as a cue for the time direction, suggested by David Pottage - more tests of intersections with open/closed ended spans 0.30 2011-04-11 - new test file t/21from_recurrence.t Contributed by Olivier Mengue 0.29 2011-04-01 - new method is_empty_set - bug #50750 0.28 2009-07-19 - optimized DateTime::Set->as_list(). This works around a segfault reported by Nils Grunwald. 0.27 2009-04-02 - fixed DateTime::Spanset duration() method. Reported by Anton Berezin 0.26 2008-12-25 - fixed DateTime::Spanset current() and set_time_zone() methods. Report and tests by Elliot Shank. 0.25 2005-10-05 - t/15time_zone.t does it's own time zone "add_duration" handling 0.24 2005-10-03 - _recurrence.pm warned when the recurrence didn't have occurrences before a given start date. Reported by Mark D. Anderson. 0.23 2005-10-03 - _recurrence.pm died when the recurrence didn't have occurrences before a given start date. Reported by Mark D. Anderson. 0.22 2005-05-06 - DateTime::Set 0.21 dies when as_list is asked to produce a list from outside the range of the set. Patch contributed by Stephen Gowing. 0.21 2005-04-06 - no hard limit in count() and as_list(); removed the warnings from the docs. 0.20 2005-02-28 - changed tests to use en_US instead of pt_BR (which changes every year) by Dave Rolsky. - optimized SpanSet methods for special cases: start_set() end_set() contains( $dt ) intersects( $dt ) - added an example to count(), by David Nicol. - added a note about how the result of min()/max() is just a copy of the actual set boundary. Reported by Ron Hill. 0.19 2004-11-29 - added more comments on as_list() and count() behaviour on large sets. Reported by Rick Frankel (rt ticket 8611) 0.18 2004-11-25 - ignore "__DIE__" signal while calculating durations. Reported by michelle.agnew (rt ticket 5434) 0.17 2004-08-17 - bugfix: it was trying to set the time zone of an "undef" value; this has broken some DT::Event::Recurrence tests - reported by Bill Moseley 0.1603 2004-07-05 - revised documentation, some examples were rewritten. - deprecate "iterate" method - Build.PM requires Set::Infinite 0.59 - reported by Tim Muller-Seydlitz 0.1602 2004-07-02 - fixed time zone handling in the methods: set_time_zone next/previous/closest/current - removed limitation of duration size in methods: add/add_duration subtract/subtract_duration - requires Set::Infinite 0.59 - uses iterate() experimental argument "backtrack_callback" - the following methods are now mutators: set_time_zone( $tz ) set( locale => $locale ) add( unit => $n ) add_duration( $dur ) subtract( unit => $n ) subtract_duration( $dur ) - fixed max/min of an infinite SpanSet - added test for infinite duration - from_recurrence() code cleanup - parameter checking: The 'dates' argument to from_datetimes() must be a list of DateTime objects 0.1601 2004-03-30 - more parameter checking; Sets should interoperate better with objects of type DateTime::Event::* and DateTime::Incomplete 0.16 2004-03-29 - Makefile.PL skips processing of "Build.PL" Reported by Reinhold May 0.15 2004-03-28 [ ENHANCEMENTS from version 0.14 ] - Both "Makefile.PL" and "Build.PL" are provided. - New methods: DateTime::SpanSet::current DateTime::Spanset::closest DateTime::Set::map / grep DateTime::SpanSet::map / grep DateTime::SpanSet::intersected_spans DateTime::SpanSet::start_set / end_set - Recurrences can be bounded sets. - Recurrences can be as small as 1 nanosecond. - DateTime::SpanSet::duration may return an 'infinite' DateTime::Duration (instead of scalar infinity). [ *** BACKWARDS INCOMPATIBILITIES from version 0.14 *** ] - The next/previous functions used in DT::Set->from_recurrence() MUST work with DateTime::Infinite::Future and DateTime::Infinite::Past parameters. Failing to test for "infinity" values is known to cause an infinite loop in some modules. - DateTime::Set and DateTime::SpanSet methods do not mutate the set. This was the behaviour in version 0.13 0.1413 2004-03-28 - detect_bounded => 1 is deprecated. 0.1412 2004-03-28 - DateTime::Set->from_recurrence - Bounded recurrences are "optional". use " detect_bounded => 1 " to turn them on. This fixes the backwards incompatibilities created by version 0.1402. 0.1411 2004-03-27 - Makefile.PL. Suggested by Randal L. Schwartz. 0.1410 2004-03-26 - Build.PL 0.1409 2004-03-23 - evaluation of bounded recurrences is "lazier". (DateTime::Incomplete tests are twice as fast) 0.1408 2004-03-22 - refactored S::I::_recurrence class: it doesn't use "current" anymore; small bugfixes & optimizations. ("current" was not documented in DT::Set) - new test: t/17quantize.t Tests a method to make "quantization" (or "discretization") of spansets. 0.1407 2004-03-16 - New methods: DateTime::SpanSet::current DateTime::Spanset::closest - "Fixed" DateTime::SpanSet::next / previous no longer "split" the returned spans. - Added examples and parameter validation to map / grep - DateTime::SpanSet::duration may return an 'infinite' DateTime::Duration, instead of scalar infinity. - Bugfix: DateTime::Spanset::union / intersection / ... correctly accept DateTime parameters. 0.1406 2004-03-15 - New methods: DateTime::Set::map / grep DateTime::SpanSet::map / grep From a discussion with Andrew Pimlott and Dave Rolsky - Cleanup "datetime" code from _recurrence.pm - iterate() marked as "internal" 0.1405 2004-03-15 - New method: DateTime::SpanSet::intersected_spans Suggested by Reinhold May Name suggested by Dave Rolsky 0.1404 2004-03-14 - New methods: DateTime::SpanSet::start_set / end_set These are the inverse of the "from_sets" method. Suggested by Reinhold May 0.1403 2004-03-10 - new method DateTime::SpanSet::iterate [ *** BACKWARDS INCOMPATIBILITIES *** ] - DateTime::Set and DateTime::SpanSet methods do not mutate the set. This is the behaviour we had before version 0.13 0.1402 2004-03-08 - Recurrence functions can be used to generate bounded sets. See: t/16bounded_recurrence.t - There is no limit on how small a recurrence can be. Recurrences as small as 1 nanosecond are possible. [ *** BACKWARDS INCOMPATIBILITIES *** ] All modules that create their own recurrences must now be able to respond to DateTime::Infinite::Future and DateTime::Infinite::Past parameters. The easiest way to do this is to add this to the first line of the recurrence subroutines: next => sub { return $_[0] if $_[0]->is_infinite; ... } previous => sub { return $_[0] if $_[0]->is_infinite; ... } 0.1401 2003-11-06 - span() was returning the set, instead of the result. 0.14 2003-11-02 - duration() should not set $@ for sets with infinity duration. Reported by Dan Kubb. 0.13 0.1205 2003-10-16 - requires Set::Infinite 0.54 (it is the "published" version of 0.5307) - DateTime::Set add_duration mutates the set. This is more compatible with the way the DateTime.pm API works. - new DateTime::SpanSet methods: as_list( $span_spec ), next( $dt|$span ), previous( $dt|$span ) 0.1204 2003-10-10 - DateTime::SpanSet and DateTime::Span inherit DateTime::Set $VERSION - Trying to subtract infinity from a datetime is not fatal in duration() Bug report by Dan Kubb. - new method 'iterate' - requires Set::Infinite 0.5307 (pass new backtracking tests) - added more tests for add_duration, subtract_duration - added set( locale => .. ) to DateTime::Set 0.1203 2003-09-26 - Added docs to Set::Infinite::_recurrence; split into a separate file such that it doesn't mix the pods - refactored union / intersection - _is_recurrence test prevents error when programming subroutine methods 0.1202 2003-09-24 - fixed set_time_zone and add_duration: was not clearing 'next' upon return, when arg was a recurrence. 0.1201 2003-09-24 - optimized contains() and intersects() when arg is a datetime - recurrence constructor always adds '->clone' to recurrence function - refactored _recurrence method; first/last of recurrences are calculated 'on demand' - requires Set::Infinite 0.5305 0.12 2003-09-22 - implement previous() in DT::SpanSet.pm - Fixed: set_time_zone would mutate a clone. 0.11 2003-09-19 - Fixed callback return value on set_time_zone. This caused the start date to be equal to the end date. Bug found by Dan Kubb. 0.10 2003-09-02 - DateTime::Span->duration now uses the new subtract_datetime_absolute method, which means that the duration is always given in seconds. - supports _huge_ recurrence sets (not infinite) with "virtual" elements. these sets have 'undef' count. Experimental - mostly untested ! this adds support for sets like 'all seconds in 2003' - faster recurrence intersection - count returns 'undef' for infinite sets. 0.09 2003-08-18 - added DT::Set count() - fixed DT::SpanSet duration() - methods that accepted a DT object, now accept a list of DT objects. Suggested by Ben Bennet, I think. - added _callback_next - "previous-only recurrences" - optimizes intersection of recurrence with span - internal 'S::I' recurrence class - small fix in DT::Set clone() - DateTime::Set uses DateTime infinity constants; max and min now return DateTime::Infinite::Future/Past objects. - DateTime::Span uses DateTime infinity constants; max and min now return DateTime::Infinite::Future/Past objects. Docs update to explain 'max()' value when a span is built using 'before'. - added method set_time_zone() - clone() is documented 0.08 2003-05-30 - recurrence set intersection uses 'current' - fixed a number of methods in DateTime::Span, including intersection, intersects, contains, union, and complement, all of which called the non-existent DateTime::Set->new method. Dave Rolsky. 0.07 2003-05-23 - some tweaking on intersection, union, and in the recurrence generator. - more tests 0.06 2003-05-14 - added 'use warnings' in some tests, added DateTime 0.12 prereq. 0.04 2003-05-12 - change "closest" code to avoid duration comparison 0.03 2003-04-27 - fixes in Set.pm as_list, span. - iterator accepts 'span' parameters. Ben Bennett - remove deprecated DateTime::Set->new and DateTime::SpanSet->new. Dave Rolsky - requires Set::Infinite 0.49 0.02 2003-04-20 - removed some calls to 'new' - added many methods from DT::Event::Recurrence - add 'span' parameter to as_list - from_recurrence now accepts next + previous 0.01 2003-04-19 - first "official" release. - implemented DateTime::SpanSet->from_sets and DateTime::SpanSet->from_set_and_duration - Many doc tweaks. Dave Rolsky - DateTime::Span->duration and DateTime::SpanSet->duration now return infinity instead of undef for infinite spans. Dave Rolsky - Added DateTime::SpanSet->empty_set. Dave Rolsky 0.00_20 2003-04-10 - Docs for DateTime::SpanSet API (not implemented) - DateTime::Span API: from_datetime_and_duration, from_datetimes 0.00_18 2003-03-25 - changes docs, changed API from_recurrence, from_datetimes, new() - as_list - previous() method (quite untested) - small API changes - revised docs, from Dave Rolsky - small bugfix in creating open spans - added DateTime::Span and DateTime::SpanSet - put "..." to mark where we need more docs - DateTime::Set and DateTime::Span API look ok. 0.00_13 2003-03-19 - added tests for set operations with recurrences/add - iterator passes all tests - the API is complete, as described in SYNOPSIS - small fix in add() syntax; accepts a duration=> parameter - iterator, next 0.00_10 2003-03-14 - union, intersection - experimental code to generate recurrence from a simple callback 0.00_07 2003-02-28 - added experimental method create_recurrence() - added experimental method add_duration() - improved SYNOPSIS - added 'immutability' tests - new() will not try to clone non-DateTime parameters (such as the Infinity value) - The program will die with an error message, if one tries to use offset() or quantize() methods These methods might come back in a later version. - new() clones its parameters. This means the parameters don't have to be immutable - new() will give an error message if we try to use a scalar parameter instead of a DateTime - Uses Set::Infinite as base class, instead of Date::Set::Timezone This means some methods just disappeared, like event() and exclude(). RFC2445 support might come back in a later revision. - Removed experimental Autoload code - Added 'Changes' and 'README' - moved POD to end of source file. DateTime-Set-0.3900/META.json0000664000175000017500000000224212776373427014773 0ustar fglockfglock{ "abstract" : "DateTime set objects", "author" : [ "Flavio S. Glock " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DateTime-Set", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "DateTime" : "0.12", "Params::Validate" : "0", "Set::Infinite" : "0.59", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/fglock/DateTime-Set.git", "web" : "https://github.com/fglock/DateTime-Set" } }, "version" : "0.3900" } DateTime-Set-0.3900/LICENSE0000644000175000017500000005010112776372742014351 0ustar fglockfglockTerms 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. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End DateTime-Set-0.3900/TODO0000644000175000017500000000462512776372742014046 0ustar fglockfglockKNOWN BUGS - the 'recurrence' argument should be $_, instead of $_[0]. This is too late to change, because there are many DateTime modules that use it. - 'set_time_zone' was published as a function, then as a mutator, then as a function, then as a mutator. It settled as a mutator. TODO list for DT::Set, DT::Span, and DT::SpanSet 2004-11-29 - DateTime::SpanSet has no count() method 2004-07-03 - what happens if the recurrence function returns an 'undef' ? (the program should die - add tests for this) - this POD entry is not entirely correct, it should be tested/fixed: The callbacks can return C and C objects, in order to define I. In this case, both 'next' and 'previous' callbacks must be defined: - 'truncate' method ? - add set_time_zone tests to Span & SpanSet - add "mutability" tests for DT::Span, DT::SpanSet see 02immutable.t - implement add/subtract in DT::Span, DT::SpanSet - implement start/end aliases in DT::Set 2004-06-25 - cleanup the examples in POD that use return $_[0] if $_[0]->is_infinite; and explain when and why to use this. - add tests for all examples given. ----------------- - Test for errors, in case the "next/previous" recurrence spec is not followed (detect infinite loop). Give a message like: "A recurrence loop was detected. Check that you are using the latest DateTime::Event module version" Or, try to detect the error and automatically "downgrade" DateTime::Set. The problem is, the infinite loops happens _inside_ next(). There seems to be no way to detect this. - implement set( locale => .. ) in Span and SpanSet - Add tests for new methods: DateTime::SpanSet::map / grep - discuss functions like is_infinite is_empty - implement faster DT::Set::complement(), using 'function composition' - move all 'set-specific' code to Set::Infinite::_recurrence use accessors instead of structure references - functions like before(), after(), during() might be useful in DT::Span or maybe these should be called next(), previous(), current(), closest() - document better: how to transform a Span into an iterator - for example, get the list of days in a span - optimization: rewrite intersection of recurrences 'previous' function - optimization: extract start_set / end_set right from the data structure, if possible. DateTime-Set-0.3900/t/0000755000175000017500000000000012776373427013613 5ustar fglockfglockDateTime-Set-0.3900/t/18as_list_empty.t0000644000175000017500000000257312776372742017033 0ustar fglockfglock#!/usr/bin/perl # this test was contributed by Stephen Gowing # more tests - Flavio use strict; use Test::More tests => 8; use DateTime; use DateTime::Set; my $d1 = DateTime->new( year => 2002, month => 3, day => 11 ); my $d2 = DateTime->new( year => 2002, month => 4, day => 11 ); my $d3 = DateTime->new( year => 2002, month => 5, day => 11 ); my( $set, $r, $n, @dt ); # infinite set # "START" $set = DateTime::Set->from_recurrence( recurrence => sub { $_[0]->truncate( to => 'month' )->add( months => 1 ) } ); @dt = $set->as_list; $r = scalar @dt; is($r, 1, 'Infinite date set - as_list - returns a single, "undef" element, as documented'); is($dt[0], undef, 'Infinite date set - as_list - the element is undef'); $n = $set->count; is($n, undef, 'Infinite date set - count is undef'); # set with 1 element $set = DateTime::Set->from_datetimes( dates => [ $d1 ] ); @dt = $set->as_list; $r = join(' ', @dt); is($r, '2002-03-11T00:00:00', 'Single date set - as_list'); $n = $set->count; is($n, 1, 'Single date set - count is 1'); # empty set @dt = $set->as_list( start => $d2, end => $d3 ); $r = join(' ', @dt); is( scalar @dt, 0, 'Out of range / empty set - as_list returns an empty list'); is($r, '', 'Out of range / empty set - as_list stringifies as an empty string'); $n = $set->count( start => $d2, end => $d3 ); is($n, 0, 'Out of range / empty set - count is zero'); DateTime-Set-0.3900/t/02immutable.t0000644000175000017500000000300212776372742016113 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 11; use DateTime; use DateTime::Set; #====================================================================== # SET ELEMENT IMMUTABILITY TESTS #====================================================================== my $t1 = new DateTime( year => '1810', month => '11', day => '22' ); my $t2 = new DateTime( year => '1900', month => '11', day => '22' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); ok( $s1->min->ymd eq '1810-11-22', 'got 1810-11-22 - min' ); $t1->add( days => 3 ); ok( $t1->ymd eq '1810-11-25', 'change object to 1810-11-25' ); ok( $s1->min->ymd eq '1810-11-22', 'still getting '. $s1->min->ymd . ' - after changing original object' ); $s1->set_time_zone( 'America/Sao_Paulo' ); is( $s1->min->time_zone_long_name, 'America/Sao_Paulo', 'changing object time zone in place' ); $s1->add( hours => 2 ); is( $s1->min->hour, 2 , 'changing object hour in place' ); # map { my $s2 = $s1->map( sub { $_->add( days => 2 ) } ); isa_ok( $s2, 'DateTime::Set' ); is( $s2->min->ymd.",".$s2->max->ymd, "1810-11-24,1900-11-24", "map" ); is( $s1->min->ymd.",".$s1->max->ymd, "1810-11-22,1900-11-22", "map does not mutate set" ); } # grep { my $t = new DateTime( year => '1850' ); my $s2 = $s1->grep( sub { $_ > $t } ); isa_ok( $s2, 'DateTime::Set' ); is( $s2->min->ymd.",".$s2->max->ymd, "1900-11-22,1900-11-22", "grep" ); is( $s1->min->ymd.",".$s1->max->ymd, "1810-11-22,1900-11-22", "grep does not mutate set" ); } 1; DateTime-Set-0.3900/t/09spanset.t0000644000175000017500000003315212776372742015631 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 53; use DateTime; use DateTime::Duration; use DateTime::Set; use DateTime::SpanSet; # use warnings; use constant INFINITY => DateTime::INFINITY; use constant NEG_INFINITY => DateTime::NEG_INFINITY; sub str { if ( ref($_[0]) ) { return $_[0]->datetime if $_[0]->is_finite; return INFINITY if $_[0]->isa( "DateTime::Infinite::Future" ); return NEG_INFINITY; } return $_[0]; } sub span_str { eval { str($_[0]->min) . '..' . str($_[0]->max) } } #====================================================================== # SPANSET TESTS #====================================================================== { my $start1 = new DateTime( year => '1810', month => '9', day => '20' ); my $end1 = new DateTime( year => '1811', month => '10', day => '21' ); my $start2 = new DateTime( year => '1812', month => '11', day => '22' ); my $end2 = new DateTime( year => '1813', month => '12', day => '23' ); my $start_set = DateTime::Set->from_datetimes( dates => [ $start1, $start2 ] ); my $end_set = DateTime::Set->from_datetimes( dates => [ $end1, $end2 ] ); my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $end_set ); my $iter = $s1->iterator; my $res = span_str( $iter->next ); is( $res, '1810-09-20T00:00:00..1811-10-21T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1812-11-22T00:00:00..1813-12-23T00:00:00', "got $res" ); # reverse with start/end dates $s1 = DateTime::SpanSet->from_sets( start_set => $end_set, end_set => $start_set ); $iter = $s1->iterator; $res = span_str( $iter->next ); is( $res, NEG_INFINITY.'..1810-09-20T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1811-10-21T00:00:00..1812-11-22T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1813-12-23T00:00:00..'.INFINITY, "got $res" ); # as_list my @spans = $s1->as_list; isa_ok ( $spans[0], 'DateTime::Span' ); $res = span_str( $spans[0] ); is( $res, NEG_INFINITY.'..1810-09-20T00:00:00', "as_list got $res" ); # intersected_spans my $intersected = $s1->intersected_spans( $end1 ); $res = span_str( $intersected ); # diag "intersected with ". span_str( $s1 ); is( $res, $end1->datetime .'..'.$start2->datetime, "intersected got $res" ); { # next( $dt ) my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $end_set ); my $dt = new DateTime( year => '1809', month => '8', day => '19' ); my $next = $s1->next( $dt ); $res = span_str( $next ); is( $res, '1810-09-20T00:00:00..1811-10-21T00:00:00', "next dt got $res" ); is( $next->end_is_open, 1, 'end is open' ); is( $next->start_is_open, 0, 'start is closed' ); # next( $span ) $next = $s1->next( $next ); $res = span_str( $next ); is( $res, '1812-11-22T00:00:00..1813-12-23T00:00:00', "next span got $res" ); is( $next->end_is_open, 1, 'end is open' ); is( $next->start_is_open, 0, 'start is closed' ); } { # previous( $dt ) my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $end_set ); my $dt = new DateTime( year => '1812', month => '11', day => '25' ); my $previous = $s1->previous( $dt ); $res = span_str( $previous ); is( $res, '1810-09-20T00:00:00..1811-10-21T00:00:00', "previous dt got $res" ); my $current = $s1->current( $dt ); $res = span_str( $current ); is( $res, '1812-11-22T00:00:00..1813-12-23T00:00:00', "current dt got $res" ); my $closest = $s1->closest( $dt ); $res = span_str( $closest ); is( $res, '1812-11-22T00:00:00..1813-12-23T00:00:00', "closest dt got $res" ); $dt = new DateTime( year => '1812', month => '11', day => '20' ); $closest = $s1->closest( $dt ); $res = span_str( $closest ); is( $res, '1812-11-22T00:00:00..1813-12-23T00:00:00', "closest dt got $res" ); $dt = new DateTime( year => '1811', month => '10', day => '25' ); $closest = $s1->closest( $dt ); $res = span_str( $closest ); is( $res, '1810-09-20T00:00:00..1811-10-21T00:00:00', "closest dt got $res" ); $dt = new DateTime( year => '1812', month => '8', day => '19' ); $previous = $s1->previous( $dt ); $res = span_str( $previous ); is( $res, '1810-09-20T00:00:00..1811-10-21T00:00:00', "previous dt got $res" ); is( $previous->end_is_open, 1, 'end is open' ); is( $previous->start_is_open, 0, 'start is closed' ); # previous( $span ) $previous = $s1->previous( $previous ); is( $previous, undef , 'no previous' ); #$res = span_str( $previous ); #is( $res, NEG_INFINITY.'..1810-09-20T00:00:00', # "previous span got $res" ); #is( eval{ $previous->end_is_open }, 1, 'end is open' ); #is( eval{ $previous->start_is_open }, 1, 'start is open' ); #is( eval{ $previous->duration->delta_seconds }, INFINITY, 'span size is infinite' ); } # TODO: { # local $TODO = 'spanset duration should be an object'; # eval { is ( $s1->duration->delta_seconds, INFINITY, 'spanset size is infinite' ); # } or # ok( 0, 'not a duration object' ); # } } # special case: end == start { my $start1 = new DateTime( year => '1810', month => '9', day => '20' ); my $end1 = new DateTime( year => '1811', month => '10', day => '21' ); my $start2 = new DateTime( year => '1811', month => '10', day => '21' ); my $end2 = new DateTime( year => '1812', month => '11', day => '22' ); my $start_set = DateTime::Set->from_datetimes( dates => [ $start1, $start2 ] ); my $end_set = DateTime::Set->from_datetimes( dates => [ $end1, $end2 ] ); my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $end_set ); my $iter = $s1->iterator; my $res = span_str( $iter->next ); is( $res, '1810-09-20T00:00:00..1811-10-21T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1811-10-21T00:00:00..1812-11-22T00:00:00', "got $res" ); } # special case: start_set == end_set { my $start1 = new DateTime( year => '1810', month => '9', day => '20' ); my $start2 = new DateTime( year => '1811', month => '10', day => '21' ); my $start3 = new DateTime( year => '1812', month => '11', day => '22' ); my $start4 = new DateTime( year => '1813', month => '12', day => '23' ); my $start_set = DateTime::Set->from_datetimes( dates => [ $start1, $start2, $start3, $start4 ] ); my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $start_set ); my $iter = $s1->iterator; my $res = span_str( $iter->next ); is( $res, NEG_INFINITY.'..1810-09-20T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1810-09-20T00:00:00..1811-10-21T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1811-10-21T00:00:00..1812-11-22T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1812-11-22T00:00:00..1813-12-23T00:00:00', "got $res" ); $res = span_str( $iter->next ); is( $res, '1813-12-23T00:00:00..'.INFINITY, "got $res" ); } # special case: start_set == end_set == recurrence { my $start_set = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'day' ) ->add( days => 1 ) }, span => DateTime::Span->from_datetimes( start => new DateTime( year => '1810', month => '9', day => '20' ) ), ); # test if the recurrence works properly my $set_iter = $start_set->iterator; my $res = str( $set_iter->next ); is( $res, '1810-09-20T00:00:00', "recurrence works properly - got $res" ); $res = str( $set_iter->next ); is( $res, '1810-09-21T00:00:00', "recurrence works properly - got $res" ); # create spanset my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $start_set ); my $iter = $s1->iterator; $res = span_str( $iter->next ); is( $res, NEG_INFINITY.'..1810-09-20T00:00:00', "start_set == end_set recurrence works properly - got $res" ); $res = span_str( $iter->next ); is( $res, '1810-09-20T00:00:00..1810-09-21T00:00:00', "start_set == end_set recurrence works properly - got $res" ); $res = span_str( $iter->next ); is( $res, '1810-09-21T00:00:00..1810-09-22T00:00:00', "start_set == end_set recurrence works properly - got $res" ); } # set_and_duration { my $start_set = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'day' ) ->add( days => 1 ) }, span => DateTime::Span->from_datetimes( start => new DateTime( year => '1810', month => '9', day => '20' ) ), ); my $span_set = DateTime::SpanSet->from_set_and_duration( set => $start_set, hours => 1 ); my $iter = $span_set->iterator; my $res = span_str( $iter->next ); is( $res, '1810-09-20T00:00:00..1810-09-20T01:00:00', "start_set == end_set recurrence works properly - got $res" ); $res = span_str( $iter->next ); is( $res, '1810-09-21T00:00:00..1810-09-21T01:00:00', "start_set == end_set recurrence works properly - got $res" ); } # test the iterator limits. Ben Bennett. { my $start1 = new DateTime( year => '1810', month => '9', day => '20' ); my $end1 = new DateTime( year => '1811', month => '10', day => '21' ); my $start2 = new DateTime( year => '1812', month => '11', day => '22' ); my $end2 = new DateTime( year => '1813', month => '12', day => '23' ); my $end3 = new DateTime( year => '1813', month => '12', day => '1' ); my $start_set = DateTime::Set->from_datetimes( dates => [ $start1, $start2 ] ); my $end_set = DateTime::Set->from_datetimes( dates => [ $end1, $end2 ] ); my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $end_set ); my $iter_all = $s1->iterator; my $iter_limit = $s1->iterator(start => $start1, end => $end3); my $iter_limit2 = $s1->iterator( span => DateTime::Span->from_datetimes( start => $start1, end => $end3) ); my $res_a = span_str( $iter_all->next ); my $res_l = span_str( $iter_limit->next ); my $res_2 = span_str( $iter_limit2->next ); is( $res_a, $res_l, "limited iterator got $res_a" ); is( $res_a, $res_2, "other limited iterator got $res_a" ); $res_a = span_str( $iter_all->next ); $res_l = span_str( $iter_limit->next ); is( $res_l, '1812-11-22T00:00:00..1813-12-01T00:00:00', "limited iterator works properly" ); is( $res_a, '1812-11-22T00:00:00..1813-12-23T00:00:00', "limited iterator doesn't break regular iterator" ); } { # start_set / end_set my $start1 = new DateTime( year => '1810', month => '9', day => '20' ); my $end1 = new DateTime( year => '1811', month => '10', day => '21' ); my $start2 = new DateTime( year => '1812', month => '11', day => '22' ); my $end2 = new DateTime( year => '1813', month => '12', day => '23' ); my $end3 = new DateTime( year => '1813', month => '12', day => '1' ); my $start_set = DateTime::Set->from_datetimes( dates => [ $start1, $start2 ] ); my $end_set = DateTime::Set->from_datetimes( dates => [ $end1, $end2 ] ); my $s1 = DateTime::SpanSet->from_sets( start_set => $start_set, end_set => $end_set ); isa_ok( $s1->start_set , "DateTime::Set" , "start_set" ); isa_ok( $s1->end_set , "DateTime::Set" , "end_set" ); is( "".$s1->start_set->{set}, "".$start_set->{set} , "start_set" ); is( "".$s1->end_set->{set}, "".$end_set->{set} , "end_set" ); } { # start_set / end_set using recurrences my $start_set = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'day' ) ->add( days => 1 ) }, ); my $span_set = DateTime::SpanSet->from_set_and_duration( set => $start_set, hours => 1 ); my $dt = new DateTime( year => '1810', month => '9', day => '20', hour => 12 ); my $res; $res = span_str( $span_set->next( $dt ) ); is( $res, '1810-09-21T00:00:00..1810-09-21T01:00:00', "next span_set occurrence - got $res" ); my $set1 = $span_set->start_set; $res = $set1->next( $dt ); is( $res->datetime, '1810-09-21T00:00:00', "next span_set-start occurrence - got $res" ); my $set2 = $span_set->end_set; $res = $set2->next( $dt ); is( $res->datetime, '1810-09-21T01:00:00', "next span_set-end occurrence - got $res" ); ok( ! $span_set->contains( $dt ), "span_set recurrence does not contain" ); ok( $span_set->contains( DateTime->new( year => '1810', month => '9', day => '20', hour => 0 ) ), "span_set recurrence contains, dt == start" ); ok( ! $span_set->contains( DateTime->new( year => '1810', month => '9', day => '20', hour => 1 ) ), "span_set recurrence does not contain, dt == end" ); ok( ! $span_set->intersects( DateTime->new( year => '1810', month => '9', day => '20', hour => 1 ) ), "span_set recurrence does not intersect, dt == end" ); } DateTime-Set-0.3900/t/03add_subtract.t0000644000175000017500000000217612776372742016607 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 6; use DateTime; use DateTime::Duration; use DateTime::Set; #====================================================================== # ADD/SUBRACT DURATION ("OFFSET") TESTS #====================================================================== my $t1 = new DateTime( year => '1810', month => '11', day => '22' ); my $t2 = new DateTime( year => '1900', month => '11', day => '22' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); my $dur1 = new DateTime::Duration ( years => 1 ); my $s2 = $s1->add_duration( $dur1 ); is( $s2->count, 2, "count" ); is( $s2->min->ymd, '1811-11-22', 'got 1811-11-22 - min' ); $s2 = $s2->clone->add( months => 1 ); is( $s2->min->ymd, '1811-12-22', 'got 1811-12-22 - min' ); my $s3 = $s2->clone->subtract_duration( DateTime::Duration->new( months => 1 ) ); is( $s3->min->ymd, '1811-11-22', 'got 1811-11-22 - min' ); my $s4 = $s3->clone->subtract( years => 1 ); is( $s4->min->ymd, '1810-11-22', 'got 1810-11-22 - min' ); # check for immutability is( $s2->min->ymd, '1811-12-22', 'got 1811-12-22 - min' ); 1; DateTime-Set-0.3900/t/00load.t0000644000175000017500000000013712776372742015057 0ustar fglockfglock#!/usr/bin/perl -w # $Header$ use Test::More; plan tests => 1; use_ok( 'DateTime::Set' ); DateTime-Set-0.3900/t/04recurrence.t0000644000175000017500000001130612776372742016301 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 25; use DateTime; use DateTime::Duration; use DateTime::Set; # use warnings; #====================================================================== # recurrence #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); my $res; my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); my $month_callback = sub { $_[0]->truncate( to => 'month' ); # warn " truncate = ".$_[0]->ymd; $_[0]->add( months => 1 ); # warn " add = ".$_[0]->ymd; return $_[0]; }; my $months = DateTime::Set->from_recurrence( recurrence => $month_callback, ); # contains datetime, unbounded set { my $t0 = $t2->clone->truncate( to => 'month' ); my $t0_set = DateTime::Set->from_datetimes( dates => [ $t0 ] ); is( $months->contains( $t1 ), 0, "does not contain datetime" ); is( $months->contains( $t1, $t0 ), 0, "does not contain datetime list" ); is( $months->contains( $t0 ), 1, "contains datetime" ); is( $months->intersects( $t1 ), 0, "does not intersect datetime" ); is( $months->intersects( $t1, $t0 ), 1, "intersects datetime list" ); is( $months->intersects( $t0 ), 1, "intersects datetime" ); ok( ! defined $months->contains( $months ) , "contains - can't do it with both unbounded sets, returns undef" ); is( $t0_set->intersects( $months ), 1, "intersects unbounded set" ); } # "START" $months = DateTime::Set->from_recurrence( recurrence => $month_callback, start => $t1, # 1810-08-22 ); # contains datetime, semi-bounded set { my $t0 = $t2->clone->truncate( to => 'month' ); is( $months->contains( $t1 ), 0, "does not contain datetime" ); is( $months->contains( $t1, $t0 ), 0, "does not contain datetime list" ); is( $months->contains( $t0 ), 1, "contains datetime" ); is( $months->intersects( $t1 ), 0, "does not intersect datetime" ); is( $months->intersects( $t1, $t0 ), 1, "intersects datetime list" ); is( $months->intersects( $t0 ), 1, "intersects datetime" ); } $res = $months->min; $res = $res->ymd if ref($res); is( $res, '1810-09-01', "min()" ); $res = $months->max; # $res = $res->ymd if ref($res); is( ref($res), 'DateTime::Infinite::Future', "max()" ); # "END" $months = DateTime::Set->from_recurrence( recurrence => $month_callback, end => $t1, # 1810-08-22 ); $res = $months->min; # $res = $res->ymd if ref($res); is( ref($res), 'DateTime::Infinite::Past', "min()" ); { $res = $months->max; $res = $res->ymd if ref($res); is( $res, '1810-08-01', "max()" ); } is( $months->count, undef, "count" ); # "START+END" $months = DateTime::Set->from_recurrence( recurrence => $month_callback, start => $t1, # 1810-08-22 end => $t2, # 1810-11-24 ); $res = $months->min; $res = $res->ymd if ref($res); is( $res, '1810-09-01', "min()" ); { $res = $months->max; $res = $res->ymd if ref($res); is( $res, '1810-11-01', "max()" ); } # "START+END" at recurrence $t1->set( day => 1 ); # month=8 $t2->set( day => 1 ); # month=11 $months = DateTime::Set->from_recurrence( recurrence => $month_callback, start => $t1, end => $t2, ); $res = $months->min; $res = $res->ymd if ref($res); is( $res, '1810-08-01', "min()" ); { $res = $months->max; $res = $res->ymd if ref($res); is( $res, '1810-11-01', "max()" ); } { # verify that the set-span when backtracking is ok. # This is _critical_ for doing correct intersections $res = $months->intersection( DateTime->new( year=>1810, month=>11, day=>1 ) ); $res = $res->max; $res = $res->ymd if ref($res); is( $res, '1810-11-01', "intersection at the recurrence" ); } # big set - "START+END" at recurrence { my $set = DateTime::SpanSet->from_spans( spans => [ DateTime::Span->from_datetimes( start => new DateTime( year => '1950', month => '08', day => '22' ), end => new DateTime( year => '2000', month => '08', day => '22' ), ), DateTime::Span->from_datetimes( start => new DateTime( year => '2350', month => '08', day => '22' ), end => new DateTime( year => '2400', month => '08', day => '22' ), ), ], ); my $months = DateTime::Set->from_recurrence( recurrence => $month_callback, ); my $bounded = $months->intersection( $set ); # ok( ! defined $bounded->count, "will not count: there are too many elements" ); is( $bounded->count, 1200, "too many elements - iterate" ); } 1; DateTime-Set-0.3900/t/15time_zone.t0000644000175000017500000001052112776372742016135 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 14; use DateTime; use DateTime::Set; #====================================================================== # TIME ZONE TESTS #====================================================================== my $t1 = new DateTime( year => '2001', month => '11', day => '22' ); my $t2 = new DateTime( year => '2002', month => '11', day => '22' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); my $s2 = $s1->set_time_zone( 'Asia/Taipei' ); is( $s2->min->datetime, '2001-11-22T00:00:00', 'got 2001-11-22T00:00:00 - min' ); is( $s2->min->time_zone->name, 'Asia/Taipei', 'got time zone name from set' ); my $span1 = DateTime::Span->from_datetimes( start => $t1, end => $t2 ); $span1->set_time_zone( 'America/Sao_Paulo' ); my $span2 = $span1->clone; $span1->set_time_zone( 'Asia/Taipei' ); is( $span1->start->datetime, '2001-11-22T10:00:00', 'got 2001-11-22T10:00:00 - min' ); is( $span1->end->datetime, '2002-11-22T10:00:00', 'got 2002-11-22T10:00:00 - max' ); # check for immutability is( $span2->start->datetime, '2001-11-22T00:00:00', 'got 2001-11-22T00:00:00 - min' ); is( $span2->end->datetime, '2002-11-22T00:00:00', 'got 2002-11-22T00:00:00 - max' ); # recurrence { my $months = DateTime::Set->from_recurrence( recurrence => sub { my $tz = $_[0]->time_zone; $_[0]->set_time_zone( 'floating' ); $_[0]->truncate( to => 'month' )->add( months => 1 ); $_[0]->set_time_zone( $tz ); $_[0]; } ) ->set_time_zone( 'Asia/Taipei' ); my $str = $months->next( $t1 )->datetime . ' ' . $months->next( $t1 )->time_zone_long_name; my $original = $t1->datetime . ' ' . $t1->time_zone_long_name; is( $str, '2001-12-01T00:00:00 Asia/Taipei', 'recurrence with time zone' ); is( $original, '2001-11-22T00:00:00 floating', 'does not mutate arg' ); { my $str; my $dt_floating = new DateTime( year => 2001, month => 11, day => 1 ); my $dt_with_tz = $dt_floating->clone->set_time_zone( 'America/Sao_Paulo' ); my $set_floating = DateTime::Set->from_recurrence( recurrence => sub { my $tz = $_[0]->time_zone; $_[0]->set_time_zone( 'floating' ); $_[0]->truncate( to => 'month' )->add( months => 1 ); $_[0]->set_time_zone( $tz ); $_[0]; } ); my $set_with_tz = $set_floating->clone->set_time_zone( 'Asia/Taipei' ); # tests with the "next" method # floating set => floating dt is( $set_floating->next( $dt_floating )-> strftime( "%FT%H:%M:%S %{time_zone_long_name}"), '2001-12-01T00:00:00 floating', 'recurrence without time zone, arg without time zone' ); # tz set => floating dt is( $set_with_tz->next( $dt_floating )-> strftime( "%FT%H:%M:%S %{time_zone_long_name}"), '2001-12-01T00:00:00 Asia/Taipei', 'recurrence with time zone, arg without time zone' ); # floating set => tz dt is( $set_floating->next( $dt_with_tz )-> strftime( "%FT%H:%M:%S %{time_zone_long_name}"), '2001-12-01T00:00:00 America/Sao_Paulo', 'recurrence with time zone, arg without time zone' ); # TODO: { # local $TODO = "Time zone settings do not backtrack"; # bug reported by Tim Mueller-Seydlitz # tz set => tz dt is( $set_with_tz->next( $dt_with_tz )-> strftime( "%FT%H:%M:%S %{time_zone_long_name}"), # = '2001-12-01T00:00:00 Asia/Taipei', '2001-11-30T14:00:00 America/Sao_Paulo', 'recurrence with time zone, arg with time zone' ); # } # TODO: limit set_floating with a start=>dt_floating; # ask for next( dt_with_tz_before_start ) # and next( dt_with_another_tz_before_start ) # and next( dt_floating_before_start ) # and check for caching problems } # set locale, add duration is ( $months->clone->add( days => 1 )-> next( $t1 )-> strftime( "%a" ), 'Sun', 'default locale' ); is ( $months->clone->add( days => 1 )-> set( locale => 'en_US' )-> next( $t1 )-> strftime( "%a" ), 'Sun', 'new locale' ); } 1; DateTime-Set-0.3900/t/11next.t0000644000175000017500000000271412776372742015123 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 4; use DateTime; use DateTime::Set; # use warnings; #====================================================================== # next method #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); { my $set = DateTime::Set->from_recurrence ( next => sub { $_[0]->truncate( to => 'day' )->add( days => 1 ) } ); my $dt = DateTime->new( year => 2000, month => 10, day => 1, ); my $next_dt = $set->next($dt); is( $next_dt->ymd, '2000-10-02', 'next day is 2000-10-02' ); is( $set->next($next_dt)->ymd, '2000-10-03', 'next day is 2000-10-03' ); } { # previous-only recurrence my $set = DateTime::Set->from_recurrence ( previous => sub { $_[0]->truncate( to => 'day' )->subtract( days => 1 ) } ); my $dt = DateTime->new( year => 2000, month => 10, day => 1, ); my $next_dt = $set->next($dt); is( $next_dt->ymd, '2000-10-02', 'next day is 2000-10-02' ); is( $set->next($next_dt)->ymd, '2000-10-03', 'next day is 2000-10-03' ); } DateTime-Set-0.3900/t/01sanity.t0000644000175000017500000000234412776372742015452 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 9; use DateTime; use DateTime::Set; #====================================================================== # BASIC INITIALIZATION TESTS #====================================================================== my $t1 = new DateTime( year => '1810', month => '11', day => '22' ); my $t2 = new DateTime( year => '1900', month => '11', day => '22' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); ok( ($t1->ymd." and ".$t2->ymd) eq '1810-11-22 and 1900-11-22', "got 1810-11-22 and 1900-11-22 - DateTime" ); my @a = $s1->as_list; ok( ($a[0]->ymd." and ".$a[1]->ymd) eq '1810-11-22 and 1900-11-22', "got 1810-11-22 and 1900-11-22 - as_list" ); ok( $s1->min->ymd eq '1810-11-22', 'got 1810-11-22 - min' ); ok( $s1->max->ymd eq '1900-11-22', 'got 1900-11-22 - max' ); is( $s1->is_empty_set, 0, 'non-empty set is not empty' ); eval { DateTime::Set->from_datetimes() }; ok( $@, 'Cannot call from_datetimes without dates parameter' ); my $empty = DateTime::Set->empty_set; is( $empty->min, undef, 'empty set ->min should be undef' ); is( $empty->max, undef, 'empty set ->max should be undef' ); is( $empty->is_empty_set, 1, 'empty set is empty' ); 1; DateTime-Set-0.3900/t/21from_recurrence.t0000644000175000017500000001473512776372742017334 0ustar fglockfglock# Tests DateTime::Set built with from_recurrence # Copyright (c) 2009 Olivier Mengué # License: same as DateTime-Set-0.26 or any later version use Test::More; use DateTime::Set; diag('Test suite by Olivier Mengue < dolmen cpan org >'); my @set = map { DateTime->new( year => $_->[0], month => $_->[1], day => $_->[2], hour => $_->[3], minute => $_->[4], second => $_->[5], ) } map { [ split /[-T:]/ ] } qw/ 2009-02-27T08:50:05 2009-02-27T09:05:05 2009-02-27T09:20:05 2009-03-02T09:05:05 2009-03-02T09:20:05 2009-03-03T09:05:05 2009-03-03T09:20:05 /; plan tests => ($#set+1+4) # no span, next() +($#set+1+4) # no span, previous +($#set+1+4) # start, next() +($#set +4) # after, next() +($#set+1+4) # end, previous() +($#set +4) # before, previous() +($#set+1+4) # start, previous() +($#set +4) # after, previous() +($#set+1+4) # end, next() +($#set +4) # before, next() ; my $start = $set[0]; sub diag_sub { my ($name, $sub) = (shift, shift); exists $INC{'Test::More'} or eval { use Test::More }; return sub { diag("$name(", join(', ', @_), ")"); if (wantarray) { my @ret = $sub->(@_); diag('=> ', @ret); return @ret } else { my $ret = $sub->(@_); diag('=> ', $ret); return $ret; } } } my $dts = do { my $idx = 0; DateTime::Set->from_recurrence( next => diag_sub(next => sub { return $set[($idx = 0)] if ($_[0] <=> DateTime::NEG_INFINITY) <= 0; return DateTime::Infinite::Future->new if $_[0]->is_infinite or $idx == $#set; return $set[++$idx]; }), previous => diag_sub(previous => sub { return $set[($idx = $#set)] if ($_[0] <=> DateTime::INFINITY) >= 0; return DateTime::Infinite::Past->new if $_[0]->is_infinite or $idx == 0; return $set[--$idx]; }) ) }; diag("no span, next()"); { my $it = $dts->iterator; # ->current is "less or equal to" is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (@set) { is($it->next, $d, $d); } is($it->next, undef, "set end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("no span, previous()"); { my $it = $dts->iterator; is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (reverse @set) { is($it->previous, $d, $d); } is($it->previous, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("start, next()"); { my $it = $dts->iterator(start => $set[0]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (@set) { is($it->next, $d, $d); } is($it->next, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("after, next()"); { my $it = $dts->iterator(after => $set[0]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (@set[1..$#set]) { is($it->next, $d, $d); } is($it->next, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("end, previous()"); { my $it = $dts->iterator(end => $set[-1]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (reverse @set) { is($it->previous, $d, $d); } is($it->previous, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("before, previous()"); { my $it = $dts->iterator(before => $set[-1]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-2], "current(Future) is $set[-2]"); for my $d (reverse @set[0..$#set-1]) { is($it->previous, $d, $d); } is($it->previous, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("start, previous()"); { my $it = $dts->iterator(start => $set[0]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (reverse @set) { is($it->previous, $d, $d); } is($it->previous, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("after, previous()"); { my $it = $dts->iterator(after => $set[0]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (reverse @set[1..$#set]) { is($it->previous, $d, $d); } is($it->previous, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("end, next()"); { my $it = $dts->iterator(end => $set[-1]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-1], "current(Future) is $set[-1]"); for my $d (@set) { is($it->next, $d, $d); } is($it->next, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } diag("before, next()"); { my $it = $dts->iterator(before => $set[-1]); is($it->current(DateTime::Infinite::Past->new), undef, "current(Past) is empty"); is($it->current(DateTime::Infinite::Future->new), $set[-2], "current(Future) is $set[-2]"); for my $d (@set[0..$#set-1]) { is($it->next, $d, $d); } is($it->next, undef, "end -> undef"); # The set is now empty is($it->previous(DateTime::Infinite::Future->new), undef, "set is now empty"); } DateTime-Set-0.3900/t/22start_end.t0000644000175000017500000000630112776372742016126 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 34; use DateTime; use DateTime::Set; my $future = DateTime::Infinite::Future->new(); my $past = DateTime::Infinite::Past->new(); my $t1 = new DateTime( year => '1810', month => '11', day => '22' ); my $t2 = new DateTime( year => '1900', month => '11', day => '22' ); # Set tests { my $set1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); ok( $set1->min->ymd eq '1810-11-22', 'min is ' . $set1->min->ymd ); ok( $set1->max->ymd eq '1900-11-22', 'max is ' . $set1->max->ymd ); ok( $set1->start->ymd eq '1810-11-22', 'start is ' . $set1->start->ymd ); ok( $set1->end->ymd eq '1900-11-22', 'end is ' . $set1->end->ymd ); } { my $set1 = DateTime::Set->from_datetimes( dates => [ $past, $future ] ); ok( $set1->min->is_infinite, 'min is infinite' ); ok( $set1->max->is_infinite, 'max is infinite' ); ok( $set1->start->is_infinite, 'start is infinite' ); ok( $set1->end->is_infinite, 'end is infinite' ); } { my $set1 = DateTime::Set->from_datetimes( dates => [] ); ok( !defined $set1->min, 'min is undef' ); ok( !defined $set1->max, 'max is undef' ); ok( !defined $set1->start, 'start is undef' ); ok( !defined $set1->end, 'end is undef' ); } # Span tests { my $set1 = DateTime::Span->from_datetimes( start => $t1, end => $t2 ); ok( $set1->min->ymd eq '1810-11-22', 'min is ' . $set1->min->ymd ); ok( $set1->max->ymd eq '1900-11-22', 'max is ' . $set1->max->ymd ); ok( $set1->start->ymd eq '1810-11-22', 'start is ' . $set1->start->ymd ); ok( $set1->end->ymd eq '1900-11-22', 'end is ' . $set1->end->ymd ); } { my $set1 = DateTime::Span->from_datetimes( start => $past, end => $future ); ok( $set1->min->is_infinite, 'min is infinite' ); ok( $set1->max->is_infinite, 'max is infinite' ); ok( $set1->start->is_infinite, 'start is infinite' ); ok( $set1->end->is_infinite, 'end is infinite' ); } { my $set1 = DateTime::Span->from_datetimes( start => $past ); ok( $set1->max->is_infinite, 'max is infinite' ); ok( $set1->end->is_infinite, 'end is infinite' ); } # SpanSet tests { my $set1 = DateTime::SpanSet->from_spans( spans => [ DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ) ] ); ok( $set1->min->ymd eq '1810-11-22', 'min is ' . $set1->min->ymd ); ok( $set1->max->ymd eq '1900-11-22', 'max is ' . $set1->max->ymd ); ok( $set1->start->ymd eq '1810-11-22', 'start is ' . $set1->start->ymd ); ok( $set1->end->ymd eq '1900-11-22', 'end is ' . $set1->end->ymd ); } { my $set1 = DateTime::SpanSet->from_spans( spans => [ DateTime::Set->from_datetimes( dates => [ $past, $future ] ) ] ); ok( $set1->min->is_infinite, 'min is infinite' ); ok( $set1->max->is_infinite, 'max is infinite' ); ok( $set1->start->is_infinite, 'start is infinite' ); ok( $set1->end->is_infinite, 'end is infinite' ); } { my $set1 = DateTime::SpanSet->from_spans( spans => [ ] ); ok( !defined $set1->min, 'min is undef' ); ok( !defined $set1->max, 'max is undef' ); ok( !defined $set1->start, 'start is undef' ); ok( !defined $set1->end, 'end is undef' ); } 1; DateTime-Set-0.3900/t/16bounded_recurrence.t0000644000175000017500000001173312776372742020010 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 17; use DateTime; use DateTime::Duration; use DateTime::Set; use DateTime::Infinite; my $res; my $t0 = new DateTime( year => '1810', month => '05', day => '01' ); my $t1 = new DateTime( year => '1810', month => '08', day => '01' ); my $t2 = new DateTime( year => '1810', month => '11', day => '01' ); { # diag( "monthly from 1810-08-01 until infinity" ); my $_next_month = sub { # warn "next of ". $_[0]->datetime; $_[0]->truncate( to => 'month' ); $_[0]->add( months => 1 ); return $_[0] if $_[0] >= $t1; return $t1->clone; }; my $_previous_month = sub { # warn "previous of ". $_[0]->datetime; my $dt = $_[0]->clone; $_[0]->truncate( to => 'month' ); $_[0]->subtract( months => 1 ) if $_[0] == $dt; return $_[0] if $_[0] >= $t1; return DateTime::Infinite::Past->new; }; my $months = DateTime::Set->from_recurrence( next => $_next_month, previous => $_previous_month, # detect_bounded => 1, ); # contains datetime, semi-bounded set is( $months->contains( $t0 ), 0, "does not contain datetime" ); is( $months->contains( $t0, $t2 ), 0, "does not contain datetime list" ); is( $months->contains( $t2 ), 1, "contains datetime" ); is( $months->intersects( $t0 ), 0, "does not intersect datetime" ); is( $months->intersects( $t0, $t2 ), 1, "intersects datetime list" ); is( $months->intersects( $t2 ), 1, "intersects datetime" ); $res = $months->min; $res = $res->ymd if ref($res); is( $res, '1810-08-01', "min()" ); $res = $months->max; is( ref($res), 'DateTime::Infinite::Future', "max()" ); } { # diag( "monthly from infinity until 1810-08-01" ); my $_next_month = sub { # warn "next of ". $_[0]->datetime; $_[0]->truncate( to => 'month' ); $_[0]->add( months => 1 ); # warn " got ".$_[0]->datetime."\n" if $_[0] <= $t1; return $_[0] if $_[0] <= $t1; # warn " got Future\n"; return DateTime::Infinite::Future->new; }; my $_previous_month = sub { # warn "previous of ". $_[0]->datetime; # warn " got ".$t1->datetime."\n" if $_[0] > $t1; return $t1->clone if $_[0] > $t1; my $dt = $_[0]->clone; $_[0]->truncate( to => 'month' ); $_[0]->subtract( months => 1 ) if $_[0] == $dt; # warn " got ".$_[0]->datetime."\n"; return $_[0]; }; my $months = DateTime::Set->from_recurrence( next => $_next_month, previous => $_previous_month, # detect_bounded => 1, ); $res = $months->min; # $res = $res->ymd if ref($res); is( ref($res), 'DateTime::Infinite::Past', "min()" ); $res = $months->max; $res = $res->ymd if ref($res); is( $res, '1810-08-01', "max()" ); is( $months->count, undef, "count" ); } { # diag( "monthly from 1810-08-01 until 1810-11-01" ); my $_next_month = sub { # warn "next of ". $_[0]->datetime; $_[0]->truncate( to => 'month' ); $_[0]->add( months => 1 ); return $t1->clone if $_[0] < $t1; return $_[0] if $_[0] <= $t2; return DateTime::Infinite::Future->new; }; my $_previous_month = sub { # warn "previous of ". $_[0]->datetime; my $dt = $_[0]->clone; $_[0]->truncate( to => 'month' ); $_[0]->subtract( months => 1 ) if $_[0] == $dt; return DateTime::Infinite::Past->new if $_[0] < $t1; return $_[0] if $_[0] <= $t2; return $t2->clone; }; my $months = DateTime::Set->from_recurrence( next => $_next_month, previous => $_previous_month, # detect_bounded => 1, ); $res = $months->min; $res = $res->ymd if ref($res); is( $res, '1810-08-01', "min()" ); $res = $months->max; $res = $res->ymd if ref($res); is( $res, '1810-11-01', "max()" ); is( $months->count, 4, "count" ); } { # diag( "lists and recurrences are interchangeable" ); my $set = DateTime::Set->from_datetimes( dates => [ $t0, $t1, $t2 ] ); my $months = DateTime::Set->from_recurrence( next => sub{ my $dt = $set->next( $_[0] ); defined $dt ? $dt : DateTime::Infinite::Future->new; }, previous => sub{ my $dt = $set->previous( $_[0] ); defined $dt ? $dt : DateTime::Infinite::Past->new; }, # detect_bounded => 1, ); $res = $months->min; $res = $res->ymd if ref($res); is( $res , '1810-05-01', "min()" ); $res = $months->max; $res = $res->ymd if ref($res); is( $res, '1810-11-01', "max()" ); is( $months->count, 3, "count" ); } 1; DateTime-Set-0.3900/t/10previous-2.t0000644000175000017500000000270012776372742016152 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 4; use DateTime; use DateTime::Set; #====================================================================== # previous method #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); { my $set = DateTime::Set->from_recurrence ( previous => sub { $_[0]->truncate( to => 'day' )->subtract( days => 1 ) } ); my $dt = DateTime->new( year => 2000, month => 10, day => 3, ); my $prev_dt = $set->previous($dt); is( $prev_dt->ymd, '2000-10-02', 'previous day is 2000-10-02' ); is( $set->previous($prev_dt)->ymd, '2000-10-01', 'previous day is 2000-10-01' ); } { my $set = DateTime::Set->from_recurrence ( next => sub { $_[0]->truncate( to => 'day' )->add( days => 1 ) } ); my $dt = DateTime->new( year => 2000, month => 10, day => 3, ); my $prev_dt = $set->previous($dt); is( $prev_dt->ymd, '2000-10-02', 'previous day is 2000-10-02' ); is( $set->previous($prev_dt)->ymd, '2000-10-01', 'previous day is 2000-10-01' ); } DateTime-Set-0.3900/t/08span.t0000644000175000017500000000525712776372742015121 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 12; use DateTime; use DateTime::Duration; use DateTime::Set; #====================================================================== # SPAN TESTS #====================================================================== { my $t1 = new DateTime( year => 1810, month => 11, day => 22 ); my $t2 = new DateTime( year => 1900, month => 11, day => 22 ); my $s1 = DateTime::Span->from_datetime_and_duration( start => $t1, hours => 2 ); my $res = $s1->min->ymd.'T'.$s1->min->hms; ok( $res eq '1810-11-22T00:00:00', "got $res - min" ); $res = $s1->max->ymd.'T'.$s1->max->hms; ok( $res eq '1810-11-22T02:00:00', "got $res - max" ); } { my $t1 = new DateTime( year => 1800 ); my $t2 = new DateTime( year => 1900 ); my $mid = new DateTime( year => 1850 ); my $span = DateTime::Span->from_datetimes( start => $t1, end => $t2 ); ok( $span->contains($mid), "Span should contain datetime in between start and end" ); } { # infinite span my $span = DateTime::Span->from_datetimes( start => DateTime->today )->union( DateTime::Span->from_datetimes( end => DateTime->today ) ); isa_ok( $span, "DateTime::SpanSet" , "union of spans gives a spanset" ); ok( $span->min->is_infinite, "infinite start" ); ok( $span->max->is_infinite, "infinite end" ); is( $span->duration->seconds , DateTime::Set::INFINITY, "infinite duration" ); } { # empty span my $span1 = DateTime::Span->from_datetimes( start => DateTime->new( year => 2000 ), end => DateTime->new( year => 2001 ) ); my $span2 = DateTime::Span->from_datetimes( start => DateTime->new( year => 2003 ), end => DateTime->new( year => 2004 ) ); my $empty = $span1->intersection($span2); is( $empty->duration->seconds , 0, "null duration" ); } { my $t2 = new DateTime( year => 1900, month => 11, day => 22 ); my $s1 = DateTime::Span->from_datetime_and_duration( end => $t2, years => -1 ); my $res = $s1->min->ymd.'T'.$s1->min->hms; ok( $res eq '1899-11-22T00:00:00', "got $res - min" ); $res = $s1->max->ymd.'T'.$s1->max->hms; ok( $res eq '1900-11-22T00:00:00', "got $res - max" ); } { my $t2 = new DateTime( year => 1900, month => 11, day => 22 ); my $s1 = DateTime::Span->from_datetime_and_duration( end => $t2, years => 1 ); my $res = $s1->min->ymd.'T'.$s1->min->hms; ok( $res eq '1899-11-22T00:00:00', "got $res - min" ); $res = $s1->max->ymd.'T'.$s1->max->hms; ok( $res eq '1900-11-22T00:00:00', "got $res - max" ); } 1; DateTime-Set-0.3900/t/14complement.t0000644000175000017500000000302512776372742016307 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 4; use DateTime; use DateTime::Duration; use DateTime::Set; #====================================================================== # complement + recurrence #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); my $res; my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); my $month_callback = sub { $_[0]->truncate( to => 'month' ); $_[0]->add( months => 1 ); return $_[0]; }; my $months = DateTime::Set->from_recurrence( recurrence => $month_callback, start => $t1, ); $res = $months->min; $res = $res->ymd if ref($res); ok( $res eq '1810-09-01', "min() - got $res" ); my $next_months = $months->complement( $months->min ); $res = $next_months->min; $res = $res->ymd if ref($res); ok( $res eq '1810-10-01', "min() - got $res" ); # trying to duplicate an error that happens in Date::Set my $iter1 = $months->iterator; my $first = $iter1->next; $next_months = $months->complement( $first ); my $iter2 = $next_months->iterator; $res = $iter2->next; $res = $res->ymd if ref($res); ok( $res eq '1810-10-01', "min() - got $res" ); $res = $iter2->next; $res = $res->ymd if ref($res); ok( $res eq '1810-11-01', "min() - got $res" ); 1; DateTime-Set-0.3900/t/07previous.t0000644000175000017500000000500412776372742016021 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 7; use DateTime; use DateTime::Set; #====================================================================== # backtracking + previous #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); sub test { my $iterator = $_[0]->iterator; my @res; for (1..3) { my $tmp = $iterator->previous; $tmp = $tmp->ymd if UNIVERSAL::can( $tmp, 'ymd' ); push @res, $tmp if defined $tmp; } return join( ' ', @res ); } my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); # ------------- test a simple recurrence my $month_callback = sub { $_[0]->truncate( to => 'month' ); $_[0]->add( months => 1 ); return $_[0]; }; my $recurr_months = DateTime::Set->from_recurrence( recurrence => $month_callback, end => $t1, # 1810-08-22 ); is( test($recurr_months), '1810-08-01 1810-07-01 1810-06-01', "months" ); { # --------- test a more complex recurrence my $day_15_callback = sub { my $after = $_[0]->day >= 15; $_[0]->set( day => 15 ); $_[0]->truncate( to => 'day' ); $_[0]->add( months => 1 ) if $after; return $_[0]; }; my $recurr_day_15 = DateTime::Set->from_recurrence( recurrence => $day_15_callback, end => $t1, # 1810-08-22 ); is( test($recurr_day_15), '1810-08-15 1810-07-15 1810-06-15', "recurr day 15" ); # ---------- test operations with recurrences my $recurr_day_1_15 = $recurr_day_15 ->union( $recurr_months ); is( test($recurr_day_1_15), '1810-08-15 1810-08-01 1810-07-15', "union of recurrences: recurr day 1,15" ); # ---------- test add() to a recurrence my $days_15 = $recurr_months->clone->add( days => 14 ); is( test($days_15), '1810-08-15 1810-07-15 1810-06-15', "days_15" ); # check that $recurr_months is still there is( test($recurr_months), '1810-08-01 1810-07-01 1810-06-01', "months is still there" ); my $days_20 = $recurr_months->clone->add( days => 19 ); is( test($days_20), '1810-08-20 1810-07-20 1810-06-20', "days_20" ); # ---------- test operations with recurrences + add my $days_15_and_20 = $days_15 ->union( $days_20 ); is( test($days_15_and_20), '1810-08-20 1810-08-15 1810-07-20', "days_15_and_20" ); } 1; DateTime-Set-0.3900/t/12iterator_intersection.t0000644000175000017500000000446412776372742020571 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 4; use DateTime; use DateTime::Duration; use DateTime::Set; # use warnings; #====================================================================== # recurrence intersection #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); my $res; my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); # makes a set with month-day == 15 ( always 15 ) my $month_callback_1 = sub { $_[0]->add( days => -14 ) ->truncate( to => 'month' ) ->add( months => 1, days => 14 ); }; # makes a set with month-day == 15 days from end-of-month ( 13, 14, 15 or 16 ) my $month_callback_2 = sub { $_[0] ->add( days => 16 ) ->truncate( to => 'month' ) ->add( months => 1 ) ->add( days => -16 ); }; my $months1 = DateTime::Set->from_recurrence( recurrence => $month_callback_1, start => $t1, ); my $months2 = DateTime::Set->from_recurrence( recurrence => $month_callback_2, start => $t2, ); my $iterator = $months1->iterator; my @res = (); for (1..5) { my $tmp = $iterator->next; push @res, $tmp->ymd if defined $tmp; } $res = join( ' ', @res ); ok( $res eq '1810-09-15 1810-10-15 1810-11-15 1810-12-15 1811-01-15', "iterations of month1 give $res" ); $iterator = $months2->iterator; @res = (); for (1..5) { my $tmp = $iterator->next; push @res, $tmp->ymd if defined $tmp; } $res = join( ' ', @res ); ok( $res eq '1810-12-16 1811-01-16 1811-02-13 1811-03-16 1811-04-15', "iterations of month2 give $res" ); my $m12 = $months1->intersection( $months2 ); $res = $m12->min; $res = $res->ymd if ref($res); ok( $res eq '1811-04-15', "min() - got $res" ); $iterator = $m12->iterator; @res = (); for (1..3) { my $tmp = $iterator->next; push @res, $tmp->ymd if defined $tmp && ref($tmp); } $res = join( ' ', @res ); ok( $res eq '1811-04-15 1811-06-15 1811-09-15', "3 iterations give $res" ); 1; DateTime-Set-0.3900/t/19spanset_daylight_savings.t0000644000175000017500000000657012776372742021255 0ustar fglockfglock#!/usr/bin/env perl use strict; use warnings; use Test::More; use DateTime; use DateTime::SpanSet; # Check that SpanSets return spans with the correct endpoints during daylight # savings changeovers given a weekly recurrence. BEGIN { if (eval 'use DateTime::Event::Recurrence; 1') { plan tests => 552; } else { plan skip_all => 'DateTime::Event::Recurrence required for this test.'; } } test_span_set_on_day(4, 'Thursday', 27, 3); test_span_set_on_day(5, 'Friday', 28, 3); test_span_set_on_day(6, 'Saturday', 29, 3); test_span_set_on_day(6, 'Saturday', 4, 10); test_span_set_on_day(7, 'Sunday', 5, 10); test_span_set_on_day(1, 'Monday', 6, 10); sub test_span_set_on_day { my ($day_index, $day_name, $day_of_month, $month) = @_; my $span_set = DateTime::SpanSet ->from_sets( start_set => DateTime::Event::Recurrence->weekly( days => $day_index, hours => 8, minutes => 30, ), end_set => DateTime::Event::Recurrence->weekly( days => $day_index, hours => 15, minutes => 30, ), ) ->set_time_zone('Asia/Jerusalem'); my $expected_date = new_as_of_time($month, $day_of_month, 0); my $expected_start = $expected_date->clone()->add(days => -7)->set_hour(8)->set_minute(30); my $expected_end = $expected_date->clone()->add(days => -7)->set_hour(15)->set_minute(30); # Skip 2am due to daylight savings change. foreach my $hour (0..1, 3..8) { my $as_of_time = new_as_of_time($month, $day_of_month, $hour); my $span = $span_set->current($as_of_time)->span(); test_span_end_point( 'start', $span->start(), $expected_start, $as_of_time, ); test_span_end_point( 'end', $span->end(), $expected_end, $as_of_time, ); } $expected_start = $expected_date->clone()->set_hour(8)->set_minute(30); $expected_end = $expected_date->clone()->set_hour(15)->set_minute(30); foreach my $hour (9..23) { my $as_of_time = new_as_of_time($month, $day_of_month, $hour); my $span = $span_set->current($as_of_time)->span(); test_span_end_point( 'start', $span->start(), $expected_start, $as_of_time, ); test_span_end_point( 'end', $span->end(), $expected_end, $as_of_time, ); } return; } sub new_as_of_time { my ($month, $day_of_month, $hour) = @_; return DateTime->new( year => 2008, month => $month, day => $day_of_month, hour => $hour, time_zone => 'Asia/Jerusalem' ); } sub test_span_end_point { my ($end_point_name, $end_point, $expected_time, $test_input_time) = @_; my $expected_ymd = $expected_time->ymd(); my $expected_hms = $expected_time->hms(); my $test_input_string = $test_input_time->ymd() . q< > . $test_input_time->hms(); is( $end_point->ymd(), $expected_ymd, "Date for $end_point_name of span at $test_input_string.", ); is( $end_point->hms(), $expected_hms, "Time of day for $end_point_name of span at $test_input_string.", ); return; } DateTime-Set-0.3900/t/17quantize.t0000644000175000017500000000267312776372742016017 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 1; use DateTime::Set; use DateTime::SpanSet; my $months = DateTime::Set->from_recurrence( next => sub { $_[0]->truncate( to => 'month' ) ->add( months => 1 ); } ); my $spanset = DateTime::SpanSet->from_spans( spans => [ DateTime::Span->from_datetimes( start => DateTime->new( year => 2000, month => 3, day => 15 ), before => DateTime->new( year => 2001 ), ), DateTime::Span->from_datetimes( start => DateTime->new( year => 2004 ), end => DateTime->new( year => 2005 ), ), ] ); # quantize to months my $month_set = $spanset->map( sub { ( $_->intersection( $months ), $months->current( $_->min ) ) } )->start_set; is ( "" . $month_set->{set}, "2000-03-01T00:00:00,2000-04-01T00:00:00,2000-05-01T00:00:00,". "2000-06-01T00:00:00,2000-07-01T00:00:00,2000-08-01T00:00:00,". "2000-09-01T00:00:00,2000-10-01T00:00:00,2000-11-01T00:00:00,". "2000-12-01T00:00:00,2004-01-01T00:00:00,2004-02-01T00:00:00,". "2004-03-01T00:00:00,2004-04-01T00:00:00,2004-05-01T00:00:00,". "2004-06-01T00:00:00,2004-07-01T00:00:00,2004-08-01T00:00:00,". "2004-09-01T00:00:00,2004-10-01T00:00:00,2004-11-01T00:00:00,". "2004-12-01T00:00:00,2005-01-01T00:00:00" , "spanset was quantized to a set" ); DateTime-Set-0.3900/t/06backtrack.t0000644000175000017500000000464012776372742016076 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 7; use DateTime; use DateTime::Set; #====================================================================== # backtracking #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); sub test { my $iterator = $_[0]->iterator; my @res; for (1..3) { my $tmp = $iterator->next; push @res, $tmp->ymd if defined $tmp; } return join( ' ', @res ); } my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); # ------------- test a simple recurrence my $month_callback = sub { $_[0]->truncate( to => 'month' ); $_[0]->add( months => 1 ); return $_[0]; }; my $recurr_months = DateTime::Set->from_recurrence( recurrence => $month_callback, start => $t1, ); is( test($recurr_months), '1810-09-01 1810-10-01 1810-11-01', "months" ); # --------- test a more complex recurrence my $day_15_callback = sub { my $after = $_[0]->day >= 15; $_[0]->set( day => 15 ); $_[0]->truncate( to => 'day' ); $_[0]->add( months => 1 ) if $after; return $_[0]; }; my $recurr_day_15 = DateTime::Set->from_recurrence( recurrence => $day_15_callback, start => $t1, ); is( test($recurr_day_15), '1810-09-15 1810-10-15 1810-11-15', "recurr day 15" ); # ---------- test operations with recurrences my $recurr_day_1_15 = $recurr_day_15 ->union( $recurr_months ); is( test($recurr_day_1_15), '1810-09-01 1810-09-15 1810-10-01', "union of recurrences: recurr day 1,15" ); # ---------- test add() to a recurrence my $days_15 = $recurr_months->clone->add( days => 14 ); is( test($days_15), '1810-09-15 1810-10-15 1810-11-15', "days_15" ); # check that $recurr_months is still there is( test($recurr_months), '1810-09-01 1810-10-01 1810-11-01', "months is still there" ); my $days_20 = $recurr_months->clone->add( days => 19 ); is( test($days_20), '1810-09-20 1810-10-20 1810-11-20', "days_20" ); # ---------- test operations with recurrences + add my $days_15_and_20 = $days_15 ->union( $days_20 ); is( test($days_15_and_20), '1810-09-15 1810-09-20 1810-10-15', "days_15_and_20" ); 1; DateTime-Set-0.3900/t/20spanset_week_wrapped_recurrence.t0000644000175000017500000000605312776372742022574 0ustar fglockfglock#!/usr/bin/env perl use strict; use warnings; use Test::More; use DateTime; use DateTime::SpanSet; # Check that SpanSets return Spans with the correct endpoints given # the same week recurrence as its starting and ending sets. BEGIN { if (eval 'use DateTime::Event::Recurrence; 1') { plan tests => 60; } else { plan skip_all => 'DateTime::Event::Recurrence required for this test.'; } } my $recurrence = DateTime::Event::Recurrence->weekly( days => 1, hours => 8, minutes => 30, ); my $base_span_set = DateTime::SpanSet ->from_sets(start_set => $recurrence, end_set => $recurrence); my $test_time_zone = 'Australia/Adelaide'; test_end_points( $base_span_set, 'no time zone changes', undef, ); test_end_points( $base_span_set ->clone() ->set_time_zone($test_time_zone), 'time zone specified', $test_time_zone, ); test_end_points( $base_span_set ->clone() ->set_time_zone('floating') ->set_time_zone($test_time_zone), 'intermediary floating time zone', $test_time_zone, ); sub test_end_points { my ($span_set, $name, $time_zone) = @_; foreach my $hour (6..7) { test_end_points_for_hour($span_set, $name, $time_zone, $hour, 8); } foreach my $hour (8..10) { test_end_points_for_hour($span_set, $name, $time_zone, $hour, 15); } return; } sub test_end_points_for_hour { my ($span_set, $name, $time_zone, $hour, $expected_start_day_of_month) = @_; my $current_time = new_test_time(15, $hour, $time_zone); my $expected_start = new_test_time($expected_start_day_of_month, 8, $time_zone); my $expected_end = new_test_time($expected_start_day_of_month + 7, 8, $time_zone); my $span = $span_set->current($current_time)->span(); test_span_end_point( 'start', $name, $span->start(), $expected_start, $current_time, ); test_span_end_point( 'end', $name, $span->end(), $expected_end, $current_time, ); return; } sub new_test_time { my ($day_of_month, $hour, $time_zone) = @_; my %constructor_arguments = ( year => 2008, month => 12, day => $day_of_month, hour => $hour, minute => 30, ); if ($time_zone) { $constructor_arguments{time_zone} = $time_zone; } return DateTime->new(%constructor_arguments); } sub test_span_end_point { my ($end_point_name, $spanset_name, $end_point, $expected_time, $test_input_time) = @_; my $expected_ymd = $expected_time->ymd(); my $expected_hms = $expected_time->hms(); my $test_input_string = $test_input_time->ymd() . q< > . $test_input_time->hms(); is( $end_point->ymd(), $expected_ymd, "Date for $end_point_name of SpanSet with $spanset_name at $test_input_string.", ); is( $end_point->hms(), $expected_hms, "Time of day for $end_point_name of SpanSet with $spanset_name at $test_input_string.", ); return; } DateTime-Set-0.3900/t/05iterator.t0000644000175000017500000002012412776372742015774 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 12; use DateTime; use DateTime::Duration; use DateTime::Set; use DateTime::SpanSet; use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); my $res; my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); my $month_callback = sub { $_[0]->truncate( to => 'month' ) ->add( months => 1 ); }; # "START" my $months = DateTime::Set->from_recurrence( recurrence => $month_callback, start => $t1, ); $res = $months->min; $res = $res->ymd if ref($res); is( $res, '1810-09-01', "min() - got $res" ); my $iterator = $months->iterator; my @res; for (1..3) { my $tmp = $iterator->next; push @res, $tmp->ymd if defined $tmp; } $res = join( ' ', @res ); is( $res, '1810-09-01 1810-10-01 1810-11-01', "3 iterations give $res" ); # sub-second iterator { my $count = 0; my $micro_callback = sub { # truncate and add to 'microsecond' $_[0]->set( nanosecond => 1000 * int( $_[0]->nanosecond / 1000 ) ) ->add( nanoseconds => 1000 ); # warn "nanosec = ".$_[0]->datetime.'.'.sprintf('%06d',$_[0]->microsecond); # guard against an infinite loop error return INFINITY if $count++ > 50; return $_[0]; }; my $microsec = DateTime::Set->from_recurrence( recurrence => $micro_callback, start => $t1, ); my $iterator = $microsec->iterator; my @res; for (1..3) { my $tmp = $iterator->next; if (defined $tmp) { my $str = $tmp->datetime.'.'.sprintf('%06d',$tmp->microsecond); # warn "iter: $str"; push @res, $str; } } $res = join( ' ', @res ); is( $res, '1810-08-22T00:00:00.000000 1810-08-22T00:00:00.000001 1810-08-22T00:00:00.000002', "3 iterations give $res" ); } # test the iterator limits. Ben Bennett. { # Make a recurrence that returns all months my $all_months = DateTime::Set->from_recurrence( recurrence => $month_callback ); my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $span = DateTime::Span->from_datetimes( start => $t1, end => $t2 ); # make an iterator with an explicit span argument my $iter = $all_months->iterator( span => $span ); # And make sure that we run on the correct months only my $limit = 4; # Make sure we don't hit an infinite iterator my @res = (); while ( my $dt = $iter->next() and $limit--) { push @res, $dt->ymd(); } my $res = join( ' ', @res); is( $res, '1810-09-01 1810-10-01 1810-11-01', "limited iterator give $res" ); { # Make another iterator over a short time range my $iter = $all_months->iterator( start => $t1, end => $t2 ); # And make sure that we run on the correct months only $limit = 4; # Make sure we don't hit an infinite iterator @res = (); while ( my $dt = $iter->next() and $limit--) { push @res, $dt->ymd(); } $res = join( ' ', @res); is( $res, '1810-09-01 1810-10-01 1810-11-01', "limited iterator give $res" ); } # And try looping just using a start date and get 4 items # to make sure that we didn't damage the original set $iter = $all_months->iterator( start => $t1 ); $limit = 4; @res = (); while ( my $dt = $iter->next() and $limit--) { push @res, $dt->ymd(); } $res = join( ' ', @res); is( $res, '1810-09-01 1810-10-01 1810-11-01 1810-12-01', "limited iterator give $res" ); } # test SpanSet iterator { # Make a recurrence that returns all months my $all_months = DateTime::Set->from_recurrence( recurrence => $month_callback ); $all_months = DateTime::SpanSet->from_sets( start_set => $all_months, end_set => $all_months ); my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $span = DateTime::Span->from_datetimes( start => $t1, end => $t2 ); { # make an iterator with an explicit span argument my $iter = $all_months->iterator( span => $span ); # And make sure that we run on the correct months only my $limit = 4; # Make sure we don't hit an infinite iterator my @res = (); while ( my $span = $iter->next() and $limit--) { push @res, $span->min->ymd() . "," . $span->max->ymd(); } my $res = join( ' ', @res); is( $res, '1810-08-22,1810-09-01 1810-09-01,1810-10-01 '. '1810-10-01,1810-11-01 1810-11-01,1810-11-24', "limited iterator give $res" ); } { # make an iterator, again. my $iter = $all_months->iterator( span => $span ); # And make sure that we run on the correct months only my $limit = 4; # Make sure we don't hit an infinite iterator my @res = (); while ( my $span = $iter->previous() and $limit--) { push @res, $span->min->ymd() . "," . $span->max->ymd(); } my $res = join( ' ', @res); is( $res, '1810-11-01,1810-11-24 1810-10-01,1810-11-01 '. '1810-09-01,1810-10-01 1810-08-22,1810-09-01', "limited iterator give $res" ); } } { # test intersections with open/closed ended spans # Make a recurrence that returns all months my $all_months = DateTime::Set->from_recurrence( recurrence => $month_callback ); my $t1 = new DateTime( year => '1810', month => '9', day => '1' ); my $t2 = new DateTime( year => '1810', month => '11', day => '1' ); { my $span = DateTime::Span->from_datetimes( start => $t1, end => $t2 ); # make an iterator with an explicit span argument my $iter = $all_months->iterator( span => $span ); # And make sure that we run on the correct months only my $limit = 4; # Make sure we don't hit an infinite iterator my @res = (); while ( my $dt = $iter->next() and $limit--) { push @res, $dt->ymd(); } my $res = join( ' ', @res); is( $res, '1810-09-01 1810-10-01 1810-11-01', "limited iterator give $res" ); } { my $span = DateTime::Span->from_datetimes( start => $t1, before => $t2 ); # make an iterator with an explicit span argument my $iter = $all_months->iterator( span => $span ); # And make sure that we run on the correct months only my $limit = 4; # Make sure we don't hit an infinite iterator my @res = (); while ( my $dt = $iter->next() and $limit--) { push @res, $dt->ymd(); } my $res = join( ' ', @res); is( $res, '1810-09-01 1810-10-01', "limited iterator give $res" ); } { my $span = DateTime::Span->from_datetimes( after => $t1, end => $t2 ); # make an iterator with an explicit span argument my $iter = $all_months->iterator( span => $span ); # And make sure that we run on the correct months only my $limit = 4; # Make sure we don't hit an infinite iterator my @res = (); while ( my $dt = $iter->next() and $limit--) { push @res, $dt->ymd(); } my $res = join( ' ', @res); is( $res, '1810-10-01 1810-11-01', "limited iterator give $res" ); } { my $span = DateTime::Span->from_datetimes( after => $t1, before => $t2 ); # make an iterator with an explicit span argument my $iter = $all_months->iterator( span => $span ); # And make sure that we run on the correct months only my $limit = 4; # Make sure we don't hit an infinite iterator my @res = (); while ( my $dt = $iter->next() and $limit--) { push @res, $dt->ymd(); } my $res = join( ' ', @res); is( $res, '1810-10-01', "limited iterator give $res" ); } } 1; DateTime-Set-0.3900/t/13add_recurrence.t0000644000175000017500000000777512776372742017130 0ustar fglockfglock#!/usr/bin/perl -w use strict; use Test::More; plan tests => 8; use DateTime; use DateTime::Duration; use DateTime::SpanSet; use DateTime::Span; use DateTime::Set; # use warnings; #====================================================================== # add duration to recurrence #====================================================================== use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); my $res; my $t1 = new DateTime( year => '1810', month => '08', day => '22' ); my $t2 = new DateTime( year => '1810', month => '11', day => '24' ); my $s1 = DateTime::Set->from_datetimes( dates => [ $t1, $t2 ] ); my $dur = new DateTime::Duration( hours => 1 ); my $month_callback = sub { $_[0]->truncate( to => 'month' ) ->add( months => 1 ); }; { # "START" my $months = DateTime::Set->from_recurrence( recurrence => $month_callback, start => $t1, ); $res = $months->min; $res = $res->ymd if ref($res); ok( $res eq '1810-09-01', "min() - got $res" ); $res = $months->clone->add_duration( $dur )->min; $res = $res->datetime if ref($res); ok( $res eq '1810-09-01T01:00:00', "min() - got $res" ); # TODO: { # local $TODO = "backtracking add()"; # BACKTRACKING my $span = new DateTime::Span( start => new DateTime( year => 1810, month => 9, day => 1, hour => 0, minute => 30 ), end => new DateTime( year => 1810, month => 9, day => 1, hour => 1, minute => 30 ), ); my $set = $months->clone->add_duration( $dur )->intersection( $span ); my $res = $set->min; $res = $res->datetime if ref($res); $res = 'undef' unless $res; ok( $res eq '1810-09-01T01:00:00', "span intersection, add - got ".$res ); } # TODO: { # local $TODO = "backtracking subtract()"; # BACKTRACKING my $span = new DateTime::Span( start => new DateTime( year => 1810, month => 9, day => 30, hour => 22, minute => 30 ), end => new DateTime( year => 1810, month => 9, day => 30, hour => 23, minute => 30 ), ); my $set = $months->subtract_duration( $dur )->intersection( $span ); my $res = $set->min; $res = $res->datetime if ref($res); $res = 'undef' unless $res; ok( $res eq '1810-09-30T23:00:00', "span intersection, subtract - got ".$res ); } } { # INTERSECTION my $months = DateTime::Set->from_recurrence( recurrence => $month_callback, ); $res = $months->intersection( DateTime::Span->from_datetimes( after => $t1 ) )->min; $res = $res->ymd if ref($res); ok( $res eq '1810-09-01', "min() - got $res" ); # diag( " after " . $t1->datetime ); $res = $months->clone->add_duration( $dur ) ->intersection( DateTime::Span->from_datetimes( after => $t1 ) ); $res = $res->min; $res = $res->datetime if ref($res); ok( $res eq '1810-09-01T01:00:00', "min() - got $res" ); } #====================================================================== # create spanset by adding duration to recurrence #====================================================================== { # SPANSET FROM RECURRENCE AND DURATION my $months = DateTime::Set->from_recurrence( recurrence => $month_callback, ); my $spans = DateTime::SpanSet->from_set_and_duration( set => $months, duration => $dur ); $res = $spans->intersection( DateTime::Span->from_datetimes( after => $t1 ) ); # this was written step-by-step to help debugging my $first_span = $res->{set}->first; $res = $first_span->min; $res = $res->datetime if ref($res); ok( $res eq '1810-09-01T00:00:00', "min() - got $res" ); $res = $first_span->max; $res = $res->datetime if ref($res); ok( $res eq '1810-09-01T01:00:00', "max() - got $res" ); } 1; DateTime-Set-0.3900/lib/0000755000175000017500000000000012776373427014116 5ustar fglockfglockDateTime-Set-0.3900/lib/DateTime/0000755000175000017500000000000012776373427015612 5ustar fglockfglockDateTime-Set-0.3900/lib/DateTime/Span.pm0000644000175000017500000003522712776372742017061 0ustar fglockfglock# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package DateTime::Span; use strict; use DateTime::Set; use DateTime::SpanSet; use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF ); use vars qw( $VERSION ); use constant INFINITY => DateTime::INFINITY; use constant NEG_INFINITY => DateTime::NEG_INFINITY; $VERSION = $DateTime::Set::VERSION; sub set_time_zone { my ( $self, $tz ) = @_; $self->{set} = $self->{set}->iterate( sub { my %tmp = %{ $_[0]->{list}[0] }; $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a}; $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b}; \%tmp; } ); return $self; } # note: the constructor must clone its DateTime parameters, such that # the set elements become immutable sub from_datetimes { my $class = shift; my %args = validate( @_, { start => { type => OBJECT, optional => 1, }, end => { type => OBJECT, optional => 1, }, after => { type => OBJECT, optional => 1, }, before => { type => OBJECT, optional => 1, }, } ); my $self = {}; my $set; die "No arguments given to DateTime::Span->from_datetimes\n" unless keys %args; if ( exists $args{start} && exists $args{after} ) { die "Cannot give both start and after arguments to DateTime::Span->from_datetimes\n"; } if ( exists $args{end} && exists $args{before} ) { die "Cannot give both end and before arguments to DateTime::Span->from_datetimes\n"; } my ( $start, $open_start, $end, $open_end ); ( $start, $open_start ) = ( NEG_INFINITY, 0 ); ( $start, $open_start ) = ( $args{start}, 0 ) if exists $args{start}; ( $start, $open_start ) = ( $args{after}, 1 ) if exists $args{after}; ( $end, $open_end ) = ( INFINITY, 0 ); ( $end, $open_end ) = ( $args{end}, 0 ) if exists $args{end}; ( $end, $open_end ) = ( $args{before}, 1 ) if exists $args{before}; if ( $start > $end ) { die "Span cannot start after the end in DateTime::Span->from_datetimes\n"; } $set = Set::Infinite::_recurrence->new( $start, $end ); if ( $start != $end ) { # remove start, such that we have ">" instead of ">=" $set = $set->complement( $start ) if $open_start; # remove end, such that we have "<" instead of "<=" $set = $set->complement( $end ) if $open_end; } $self->{set} = $set; bless $self, $class; return $self; } sub from_datetime_and_duration { my $class = shift; my %args = @_; my $key; my $dt; # extract datetime parameters for ( qw( start end before after ) ) { if ( exists $args{$_} ) { $key = $_; $dt = delete $args{$_}; } } # extract duration parameters my $dt_duration; if ( exists $args{duration} ) { $dt_duration = $args{duration}; } else { $dt_duration = DateTime::Duration->new( %args ); } # warn "Creating span from $key => ".$dt->datetime." and $dt_duration"; my $other_date; my $other_key; if ( $dt_duration->is_positive ) { if ( $key eq 'end' || $key eq 'before' ) { $other_key = 'start'; $other_date = $dt->clone->subtract_duration( $dt_duration ); } else { $other_key = 'before'; $other_date = $dt->clone->add_duration( $dt_duration ); } } else { if ( $key eq 'end' || $key eq 'before' ) { $other_key = 'start'; $other_date = $dt->clone->add_duration( $dt_duration ); } else { $other_key = 'before'; $other_date = $dt->clone->subtract_duration( $dt_duration ); } } # warn "Creating span from $key => ".$dt->datetime." and ".$other_date->datetime; return $class->new( $key => $dt, $other_key => $other_date ); } # This method is intentionally not documented. It's really only for # use by ::Set and ::SpanSet's as_list() and iterator() methods. sub new { my $class = shift; my %args = @_; # If we find anything _not_ appropriate for from_datetimes, we # assume it must be for durations, and call this constructor. # This way, we don't need to hardcode the DateTime::Duration # parameters. foreach ( keys %args ) { return $class->from_datetime_and_duration(%args) unless /^(?:before|after|start|end)$/; } return $class->from_datetimes(%args); } sub is_empty_set { my $set = $_[0]; $set->{set}->is_null; } sub clone { bless { set => $_[0]->{set}->copy, }, ref $_[0]; } # Set::Infinite methods sub intersection { my ($set1, $set2) = @_; my $class = ref($set1); my $tmp = {}; # $class->new(); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->intersection( $set2->{set} ); # intersection() can generate something more complex than a span. bless $tmp, 'DateTime::SpanSet'; return $tmp; } sub intersects { my ($set1, $set2) = @_; my $class = ref($set1); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) unless $set2->can( 'union' ); return $set1->{set}->intersects( $set2->{set} ); } sub contains { my ($set1, $set2) = @_; my $class = ref($set1); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) unless $set2->can( 'union' ); return $set1->{set}->contains( $set2->{set} ); } sub union { my ($set1, $set2) = @_; my $class = ref($set1); my $tmp = {}; # $class->new(); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->union( $set2->{set} ); # union() can generate something more complex than a span. bless $tmp, 'DateTime::SpanSet'; # # We have to check it's internal structure to find out. # if ( $#{ $tmp->{set}->{list} } != 0 ) { # bless $tmp, 'Date::SpanSet'; # } return $tmp; } sub complement { my ($set1, $set2) = @_; my $class = ref($set1); my $tmp = {}; # $class->new; if (defined $set2) { $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2 ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->complement( $set2->{set} ); } else { $tmp->{set} = $set1->{set}->complement; } # complement() can generate something more complex than a span. bless $tmp, 'DateTime::SpanSet'; # # We have to check it's internal structure to find out. # if ( $#{ $tmp->{set}->{list} } != 0 ) { # bless $tmp, 'Date::SpanSet'; # } return $tmp; } sub start { return DateTime::Set::_fix_datetime( $_[0]->{set}->min ); } *min = \&start; sub end { return DateTime::Set::_fix_datetime( $_[0]->{set}->max ); } *max = \&end; sub start_is_open { # min_a returns info about the set boundary my ($min, $open) = $_[0]->{set}->min_a; return $open; } sub start_is_closed { $_[0]->start_is_open ? 0 : 1 } sub end_is_open { # max_a returns info about the set boundary my ($max, $open) = $_[0]->{set}->max_a; return $open; } sub end_is_closed { $_[0]->end_is_open ? 0 : 1 } # span == $self sub span { @_ } sub duration { my $dur; local $@; eval { local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434) $dur = $_[0]->end->subtract_datetime_absolute( $_[0]->start ) }; return $dur if defined $dur; return DateTime::Infinite::Future->new - DateTime::Infinite::Past->new; } *size = \&duration; 1; __END__ =head1 NAME DateTime::Span - Datetime spans =head1 SYNOPSIS use DateTime; use DateTime::Span; $date1 = DateTime->new( year => 2002, month => 3, day => 11 ); $date2 = DateTime->new( year => 2003, month => 4, day => 12 ); $set2 = DateTime::Span->from_datetimes( start => $date1, end => $date2 ); # set2 = 2002-03-11 until 2003-04-12 $set = $set1->union( $set2 ); # like "OR", "insert", "both" $set = $set1->complement( $set2 ); # like "delete", "remove" $set = $set1->intersection( $set2 ); # like "AND", "while" $set = $set1->complement; # like "NOT", "negate", "invert" if ( $set1->intersects( $set2 ) ) { ... # like "touches", "interferes" if ( $set1->contains( $set2 ) ) { ... # like "is-fully-inside" # data extraction $date = $set1->start; # first date of the span $date = $set1->end; # last date of the span =head1 DESCRIPTION C is a module for handling datetime spans, otherwise known as ranges or periods ("from X to Y, inclusive of all datetimes in between"). This is different from a C, which is made of individual datetime points as opposed to a range. There is also a module C to handle sets of spans. =head1 METHODS =over 4 =item * from_datetimes Creates a new span based on a starting and ending datetime. A 'closed' span includes its end-dates: $span = DateTime::Span->from_datetimes( start => $dt1, end => $dt2 ); An 'open' span does not include its end-dates: $span = DateTime::Span->from_datetimes( after => $dt1, before => $dt2 ); A 'semi-open' span includes one of its end-dates: $span = DateTime::Span->from_datetimes( start => $dt1, before => $dt2 ); $span = DateTime::Span->from_datetimes( after => $dt1, end => $dt2 ); A span might have just a starting date, or just an ending date. These spans end, or start, in an imaginary 'forever' date: $span = DateTime::Span->from_datetimes( start => $dt1 ); $span = DateTime::Span->from_datetimes( end => $dt2 ); $span = DateTime::Span->from_datetimes( after => $dt1 ); $span = DateTime::Span->from_datetimes( before => $dt2 ); You cannot give both a "start" and "after" argument, nor can you give both an "end" and "before" argument. Either of these conditions will cause the C method to die. To summarize, a datetime passed as either "start" or "end" is included in the span. A datetime passed as either "after" or "before" is excluded from the span. =item * from_datetime_and_duration Creates a new span. $span = DateTime::Span->from_datetime_and_duration( start => $dt1, duration => $dt_dur1 ); $span = DateTime::Span->from_datetime_and_duration( after => $dt1, hours => 12 ); The new "end of the set" is I by default. =item * clone This object method returns a replica of the given object. =item * set_time_zone( $tz ) This method accepts either a time zone object or a string that can be passed as the "name" parameter to C<< DateTime::TimeZone->new() >>. If the new time zone's offset is different from the old time zone, then the I time is adjusted accordingly. If the old time zone was a floating time zone, then no adjustments to the local time are made, except to account for leap seconds. If the new time zone is floating, then the I time is adjusted in order to leave the local time untouched. =item * duration The total size of the set, as a C object, or as a scalar containing infinity. Also available as C. =item * start, min =item * end, max First or last dates in the span. It is possible that the return value from these methods may be a C or a Cxs object. If the set ends C a date C<$dt>, it returns C<$dt>. Note that in this case C<$dt> is not a set element - but it is a set boundary. These methods return just a I of the actual boundary value. If you modify the result, the set will not be modified. =cut # scalar containing either negative infinity # or positive infinity. =item * start_is_closed =item * end_is_closed Returns true if the first or last dates belong to the span ( start <= x <= end ). =item * start_is_open =item * end_is_open Returns true if the first or last dates are excluded from the span ( start < x < end ). =item * union =item * intersection =item * complement Set operations may be performed not only with C objects, but also with C and C objects. These set operations always return a C object. $set = $span->union( $set2 ); # like "OR", "insert", "both" $set = $span->complement( $set2 ); # like "delete", "remove" $set = $span->intersection( $set2 ); # like "AND", "while" $set = $span->complement; # like "NOT", "negate", "invert" =item * intersects =item * contains These set functions return a boolean value. if ( $span->intersects( $set2 ) ) { ... # like "touches", "interferes" if ( $span->contains( $dt ) ) { ... # like "is-fully-inside" These methods can accept a C, C, C, or C object as an argument. =back =head1 SUPPORT Support is offered through the C mailing list. Please report bugs using rt.cpan.org =head1 AUTHOR Flavio Soibelmann Glock The API was developed together with Dave Rolsky and the DateTime Community. =head1 COPYRIGHT Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO Set::Infinite For details on the Perl DateTime Suite project please see L. =cut DateTime-Set-0.3900/lib/DateTime/Set.pm0000644000175000017500000010156012776373055016703 0ustar fglockfglockpackage DateTime::Set; use strict; use Carp; use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF ); use DateTime 0.12; # this is for version checking only use DateTime::Duration; use DateTime::Span; use Set::Infinite 0.59; use Set::Infinite::_recurrence; use vars qw( $VERSION ); use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); BEGIN { $VERSION = '0.3900'; } sub _fix_datetime { # internal function - # (not a class method) # # checks that the parameter is an object, and # also protects the object against mutation return $_[0] unless defined $_[0]; # error return $_[0]->clone if ref( $_[0] ); # "immutable" datetime return DateTime::Infinite::Future->new if $_[0] == INFINITY; # Inf return DateTime::Infinite::Past->new if $_[0] == NEG_INFINITY; # -Inf return $_[0]; # error } sub _fix_return_datetime { my ( $dt, $dt_arg ) = @_; # internal function - # (not a class method) # # checks that the returned datetime has the same # time zone as the parameter # TODO: set locale return unless $dt; return unless $dt_arg; if ( $dt_arg->can('time_zone_long_name') && !( $dt_arg->time_zone_long_name eq 'floating' ) ) { $dt->set_time_zone( $dt_arg->time_zone ); } return $dt; } sub iterate { # deprecated method - use map() or grep() instead my ( $self, $callback ) = @_; my $class = ref( $self ); my $return = $class->empty_set; $return->{set} = $self->{set}->iterate( sub { my $min = $_[0]->min; $callback->( $min->clone ) if ref($min); } ); $return; } sub map { my ( $self, $callback ) = @_; my $class = ref( $self ); die "The callback parameter to map() must be a subroutine reference" unless ref( $callback ) eq 'CODE'; my $return = $class->empty_set; $return->{set} = $self->{set}->iterate( sub { local $_ = $_[0]->min; next unless ref( $_ ); $_ = $_->clone; my @list = $callback->(); my $set = Set::Infinite::_recurrence->new(); $set = $set->union( $_ ) for @list; return $set; } ); $return; } sub grep { my ( $self, $callback ) = @_; my $class = ref( $self ); die "The callback parameter to grep() must be a subroutine reference" unless ref( $callback ) eq 'CODE'; my $return = $class->empty_set; $return->{set} = $self->{set}->iterate( sub { local $_ = $_[0]->min; next unless ref( $_ ); $_ = $_->clone; my $result = $callback->(); return $_ if $result; return; } ); $return; } sub add { return shift->add_duration( DateTime::Duration->new(@_) ) } sub subtract { return shift->subtract_duration( DateTime::Duration->new(@_) ) } sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) } sub add_duration { my ( $self, $dur ) = @_; $dur = $dur->clone; # $dur must be "immutable" $self->{set} = $self->{set}->iterate( sub { my $min = $_[0]->min; $min->clone->add_duration( $dur ) if ref($min); }, backtrack_callback => sub { my ( $min, $max ) = ( $_[0]->min, $_[0]->max ); if ( ref($min) ) { $min = $min->clone; $min->subtract_duration( $dur ); } if ( ref($max) ) { $max = $max->clone; $max->subtract_duration( $dur ); } return Set::Infinite::_recurrence->new( $min, $max ); }, ); $self; } sub set_time_zone { my ( $self, $tz ) = @_; $self->{set} = $self->{set}->iterate( sub { my $min = $_[0]->min; $min->clone->set_time_zone( $tz ) if ref($min); }, backtrack_callback => sub { my ( $min, $max ) = ( $_[0]->min, $_[0]->max ); if ( ref($min) ) { $min = $min->clone; $min->set_time_zone( $tz ); } if ( ref($max) ) { $max = $max->clone; $max->set_time_zone( $tz ); } return Set::Infinite::_recurrence->new( $min, $max ); }, ); $self; } sub set { my $self = shift; my %args = validate( @_, { locale => { type => SCALAR | OBJECT, default => undef }, } ); $self->{set} = $self->{set}->iterate( sub { my $min = $_[0]->min; $min->clone->set( %args ) if ref($min); }, ); $self; } sub from_recurrence { my $class = shift; my %args = @_; my %param; # Parameter renaming, such that we can use either # recurrence => xxx or next => xxx, previous => xxx $param{next} = delete $args{recurrence} || delete $args{next}; $param{previous} = delete $args{previous}; $param{span} = delete $args{span}; # they might be specifying a span using start / end $param{span} = DateTime::Span->new( %args ) if keys %args; my $self = {}; die "Not enough arguments in from_recurrence()" unless $param{next} || $param{previous}; if ( ! $param{previous} ) { my $data = {}; $param{previous} = sub { _callback_previous ( _fix_datetime( $_[0] ), $param{next}, $data ); } } else { my $previous = $param{previous}; $param{previous} = sub { $previous->( _fix_datetime( $_[0] ) ); } } if ( ! $param{next} ) { my $data = {}; $param{next} = sub { _callback_next ( _fix_datetime( $_[0] ), $param{previous}, $data ); } } else { my $next = $param{next}; $param{next} = sub { $next->( _fix_datetime( $_[0] ) ); } } my ( $min, $max ); $max = $param{previous}->( DateTime::Infinite::Future->new ); $min = $param{next}->( DateTime::Infinite::Past->new ); $max = INFINITY if $max->is_infinite; $min = NEG_INFINITY if $min->is_infinite; my $base_set = Set::Infinite::_recurrence->new( $min, $max ); $base_set = $base_set->intersection( $param{span}->{set} ) if $param{span}; # warn "base set is $base_set\n"; my $data = {}; $self->{set} = $base_set->_recurrence( $param{next}, $param{previous}, $data, ); bless $self, $class; return $self; } sub from_datetimes { my $class = shift; my %args = validate( @_, { dates => { type => ARRAYREF, }, } ); my $self = {}; $self->{set} = Set::Infinite::_recurrence->new; # possible optimization: sort datetimes and use "push" for( @{ $args{dates} } ) { # DateTime::Infinite objects are not welcome here, # but this is not enforced (it does't hurt) carp "The 'dates' argument to from_datetimes() must only contain ". "datetime objects" unless UNIVERSAL::can( $_, 'utc_rd_values' ); $self->{set} = $self->{set}->union( $_->clone ); } bless $self, $class; return $self; } sub empty_set { my $class = shift; return bless { set => Set::Infinite::_recurrence->new }, $class; } sub is_empty_set { my $set = $_[0]; $set->{set}->is_null; } sub clone { my $self = bless { %{ $_[0] } }, ref $_[0]; $self->{set} = $_[0]->{set}->copy; return $self; } # default callback that returns the # "previous" value in a callback recurrence. # # This is used to simulate a 'previous' callback, # when then 'previous' argument in 'from_recurrence' is missing. # sub _callback_previous { my ($value, $callback_next, $callback_info) = @_; my $previous = $value->clone; return $value if $value->is_infinite; my $freq = $callback_info->{freq}; unless (defined $freq) { # This is called just once, to setup the recurrence frequency my $previous = $callback_next->( $value ); my $next = $callback_next->( $previous ); $freq = 2 * ( $previous - $next ); # save it for future use with this same recurrence $callback_info->{freq} = $freq; } $previous->add_duration( $freq ); $previous = $callback_next->( $previous ); if ($previous >= $value) { # This error happens if the event frequency oscillates widely # (more than 100% of difference from one interval to next) my @freq = $freq->deltas; print STDERR "_callback_previous: Delta components are: @freq\n"; warn "_callback_previous: iterator can't find a previous value, got ". $previous->ymd." after ".$value->ymd; } my $previous1; while (1) { $previous1 = $previous->clone; $previous = $callback_next->( $previous ); return $previous1 if $previous >= $value; } } # default callback that returns the # "next" value in a callback recurrence. # # This is used to simulate a 'next' callback, # when then 'next' argument in 'from_recurrence' is missing. # sub _callback_next { my ($value, $callback_previous, $callback_info) = @_; my $next = $value->clone; return $value if $value->is_infinite; my $freq = $callback_info->{freq}; unless (defined $freq) { # This is called just once, to setup the recurrence frequency my $next = $callback_previous->( $value ); my $previous = $callback_previous->( $next ); $freq = 2 * ( $next - $previous ); # save it for future use with this same recurrence $callback_info->{freq} = $freq; } $next->add_duration( $freq ); $next = $callback_previous->( $next ); if ($next <= $value) { # This error happens if the event frequency oscillates widely # (more than 100% of difference from one interval to next) my @freq = $freq->deltas; print STDERR "_callback_next: Delta components are: @freq\n"; warn "_callback_next: iterator can't find a previous value, got ". $next->ymd." before ".$value->ymd; } my $next1; while (1) { $next1 = $next->clone; $next = $callback_previous->( $next ); return $next1 if $next >= $value; } } sub iterator { my $self = shift; my %args = @_; my $span; $span = delete $args{span}; $span = DateTime::Span->new( %args ) if %args; return $self->intersection( $span ) if $span; return $self->clone; } # next() gets the next element from an iterator() # next( $dt ) returns the next element after a datetime. sub next { my $self = shift; return undef unless ref( $self->{set} ); if ( @_ ) { if ( $self->{set}->_is_recurrence ) { return _fix_return_datetime( $self->{set}->{param}[0]->( $_[0] ), $_[0] ); } else { my $span = DateTime::Span->from_datetimes( after => $_[0] ); return _fix_return_datetime( $self->intersection( $span )->next, $_[0] ); } } my ($head, $tail) = $self->{set}->first; $self->{set} = $tail; return $head->min if defined $head; return $head; } # previous() gets the last element from an iterator() # previous( $dt ) returns the previous element before a datetime. sub previous { my $self = shift; return undef unless ref( $self->{set} ); if ( @_ ) { if ( $self->{set}->_is_recurrence ) { return _fix_return_datetime( $self->{set}->{param}[1]->( $_[0] ), $_[0] ); } else { my $span = DateTime::Span->from_datetimes( before => $_[0] ); return _fix_return_datetime( $self->intersection( $span )->previous, $_[0] ); } } my ($head, $tail) = $self->{set}->last; $self->{set} = $tail; return $head->max if defined $head; return $head; } # "current" means less-or-equal to a datetime sub current { my $self = shift; return undef unless ref( $self->{set} ); if ( $self->{set}->_is_recurrence ) { my $tmp = $self->next( $_[0] ); return $self->previous( $tmp ); } return $_[0] if $self->contains( $_[0] ); $self->previous( $_[0] ); } sub closest { my $self = shift; # return $_[0] if $self->contains( $_[0] ); my $dt1 = $self->current( $_[0] ); my $dt2 = $self->next( $_[0] ); return $dt2 unless defined $dt1; return $dt1 unless defined $dt2; my $delta = $_[0] - $dt1; return $dt1 if ( $dt2 - $delta ) >= $_[0]; return $dt2; } sub as_list { my $self = shift; return undef unless ref( $self->{set} ); my %args = @_; my $span; $span = delete $args{span}; $span = DateTime::Span->new( %args ) if %args; my $set = $self->clone; $set = $set->intersection( $span ) if $span; return if $set->{set}->is_null; # nothing = empty # Note: removing this line means we may end up in an infinite loop! ## return undef if $set->{set}->is_too_complex; # undef = no start/end return undef if $set->max->is_infinite || $set->min->is_infinite; my @result; my $next = $self->min; if ( $span ) { my $next1 = $span->min; $next = $next1 if $next1 && $next1 > $next; $next = $self->current( $next ); } my $last = $self->max; if ( $span ) { my $last1 = $span->max; $last = $last1 if $last1 && $last1 < $last; } do { push @result, $next if !$span || $span->contains($next); $next = $self->next( $next ); } while $next && $next <= $last; return @result; } sub intersection { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); my $tmp = $class->empty_set(); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->intersection( $set2->{set} ); return $tmp; } sub intersects { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); $set2 = $set2->as_set if $set2->can( 'as_set' ); unless ( $set2->can( 'union' ) ) { if ( $set1->{set}->_is_recurrence ) { for ( $set2, @_ ) { return 1 if $set1->current( $_ ) == $_; } return 0; } $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) } return $set1->{set}->intersects( $set2->{set} ); } sub contains { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); $set2 = $set2->as_set if $set2->can( 'as_set' ); unless ( $set2->can( 'union' ) ) { if ( $set1->{set}->_is_recurrence ) { for ( $set2, @_ ) { return 0 unless $set1->current( $_ ) == $_; } return 1; } $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) } return $set1->{set}->contains( $set2->{set} ); } sub union { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); my $tmp = $class->empty_set(); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->union( $set2->{set} ); bless $tmp, 'DateTime::SpanSet' if $set2->isa('DateTime::Span') or $set2->isa('DateTime::SpanSet'); return $tmp; } sub complement { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); my $tmp = $class->empty_set(); if (defined $set2) { $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = $class->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); # TODO: "compose complement"; $tmp->{set} = $set1->{set}->complement( $set2->{set} ); } else { $tmp->{set} = $set1->{set}->complement; bless $tmp, 'DateTime::SpanSet'; } return $tmp; } sub start { return _fix_datetime( $_[0]->{set}->min ); } *min = \&start; sub end { return _fix_datetime( $_[0]->{set}->max ); } *max = \&end; # returns a DateTime::Span sub span { my $set = $_[0]->{set}->span; my $self = bless { set => $set }, 'DateTime::Span'; return $self; } sub count { my ($self) = shift; return undef unless ref( $self->{set} ); my %args = @_; my $span; $span = delete $args{span}; $span = DateTime::Span->new( %args ) if %args; my $set = $self->clone; $set = $set->intersection( $span ) if $span; return $set->{set}->count unless $set->{set}->is_too_complex; return undef if $set->max->is_infinite || $set->min->is_infinite; my $count = 0; my $iter = $set->iterator; $count++ while $iter->next; return $count; } 1; __END__ =head1 NAME DateTime::Set - Datetime sets and set math =head1 SYNOPSIS use DateTime; use DateTime::Set; $date1 = DateTime->new( year => 2002, month => 3, day => 11 ); $set1 = DateTime::Set->from_datetimes( dates => [ $date1 ] ); # set1 = 2002-03-11 $date2 = DateTime->new( year => 2003, month => 4, day => 12 ); $set2 = DateTime::Set->from_datetimes( dates => [ $date1, $date2 ] ); # set2 = 2002-03-11, and 2003-04-12 $date3 = DateTime->new( year => 2003, month => 4, day => 1 ); print $set2->next( $date3 )->ymd; # 2003-04-12 print $set2->previous( $date3 )->ymd; # 2002-03-11 print $set2->current( $date3 )->ymd; # 2002-03-11 print $set2->closest( $date3 )->ymd; # 2003-04-12 # a 'monthly' recurrence: $set = DateTime::Set->from_recurrence( recurrence => sub { return $_[0] if $_[0]->is_infinite; return $_[0]->truncate( to => 'month' )->add( months => 1 ) }, span => $date_span1, # optional span ); $set = $set1->union( $set2 ); # like "OR", "insert", "both" $set = $set1->complement( $set2 ); # like "delete", "remove" $set = $set1->intersection( $set2 ); # like "AND", "while" $set = $set1->complement; # like "NOT", "negate", "invert" if ( $set1->intersects( $set2 ) ) { ... # like "touches", "interferes" if ( $set1->contains( $set2 ) ) { ... # like "is-fully-inside" # data extraction $date = $set1->min; # first date of the set $date = $set1->max; # last date of the set $iter = $set1->iterator; while ( $dt = $iter->next ) { print $dt->ymd; }; =head1 DESCRIPTION DateTime::Set is a module for datetime sets. It can be used to handle two different types of sets. The first is a fixed set of predefined datetime objects. For example, if we wanted to create a set of datetimes containing the birthdays of people in our family for the current year. The second type of set that it can handle is one based on a recurrence, such as "every Wednesday", or "noon on the 15th day of every month". This type of set can have fixed starting and ending datetimes, but neither is required. So our "every Wednesday set" could be "every Wednesday from the beginning of time until the end of time", or "every Wednesday after 2003-03-05 until the end of time", or "every Wednesday between 2003-03-05 and 2004-01-07". This module also supports set math operations, so you do things like create a new set from the union or difference of two sets, check whether a datetime is a member of a given set, etc. This is different from a C, which handles a continuous range as opposed to individual datetime points. There is also a module C to handle sets of spans. =head1 METHODS =over 4 =item * from_datetimes Creates a new set from a list of datetimes. $dates = DateTime::Set->from_datetimes( dates => [ $dt1, $dt2, $dt3 ] ); The datetimes can be objects from class C, or from a C class. C objects are not valid set members. =item * from_recurrence Creates a new set specified via a "recurrence" callback. $months = DateTime::Set->from_recurrence( span => $dt_span_this_year, # optional span recurrence => sub { return $_[0]->truncate( to => 'month' )->add( months => 1 ) }, ); The C parameter is optional. It must be a C object. The span can also be specified using C / C and C / C parameters, as in the C constructor. In this case, if there is a C parameter it will be ignored. $months = DateTime::Set->from_recurrence( after => $dt_now, recurrence => sub { return $_[0]->truncate( to => 'month' )->add( months => 1 ); }, ); The recurrence function will be passed a single parameter, a datetime object. The parameter can be an object from class C, or from one of the C classes. The parameter can also be a C or a C object. The recurrence must return the I event after that object. There is no guarantee as to what the returned object will be set to, only that it will be greater than the object passed to the recurrence. If there are no more datetimes after the given parameter, then the recurrence function should return C. It is ok to modify the parameter C<$_[0]> inside the recurrence function. There are no side-effects. For example, if you wanted a recurrence that generated datetimes in increments of 30 seconds, it would look like this: sub every_30_seconds { my $dt = shift; if ( $dt->second < 30 ) { return $dt->truncate( to => 'minute' )->add( seconds => 30 ); } else { return $dt->truncate( to => 'minute' )->add( minutes => 1 ); } } Note that this recurrence takes leap seconds into account. Consider using C in this manner to avoid complicated arithmetic problems! It is also possible to create a recurrence by specifying either or both of 'next' and 'previous' callbacks. The callbacks can return C and C objects, in order to define I. In this case, both 'next' and 'previous' callbacks must be defined: # "monthly from $dt until forever" my $months = DateTime::Set->from_recurrence( next => sub { return $dt if $_[0] < $dt; $_[0]->truncate( to => 'month' ); $_[0]->add( months => 1 ); return $_[0]; }, previous => sub { my $param = $_[0]->clone; $_[0]->truncate( to => 'month' ); $_[0]->subtract( months => 1 ) if $_[0] == $param; return $_[0] if $_[0] >= $dt; return DateTime::Infinite::Past->new; }, ); Bounded recurrences are easier to write using C parameters. See above. See also C and the other C factory modules for generating specialized recurrences, such as sunrise and sunset times, and holidays. =item * empty_set Creates a new empty set. $set = DateTime::Set->empty_set; print "empty set" unless defined $set->max; =item * is_empty_set Returns true is the set is empty; false otherwise. print "nothing" if $set->is_empty_set; =item * clone This object method returns a replica of the given object. C is useful if you want to apply a transformation to a set, but you want to keep the previous value: $set2 = $set1->clone; $set2->add_duration( year => 1 ); # $set1 is unaltered =item * add_duration( $duration ) This method adds the specified duration to every element of the set. $dt_dur = new DateTime::Duration( year => 1 ); $set->add_duration( $dt_dur ); The original set is modified. If you want to keep the old values use: $new_set = $set->clone->add_duration( $dt_dur ); =item * add This method is syntactic sugar around the C method. $meetings_2004 = $meetings_2003->clone->add( years => 1 ); =item * subtract_duration( $duration_object ) When given a C object, this method simply calls C on that object and passes that new duration to the C method. =item * subtract( DateTime::Duration->new parameters ) Like C, this is syntactic sugar for the C method. =item * set_time_zone( $tz ) This method will attempt to apply the C method to every datetime in the set. =item * set( locale => .. ) This method can be used to change the C of a datetime set. =item * start, min =item * end, max The first and last C in the set. These methods may return C if the set is empty. It is also possible that these methods may return a C or C object. These methods return just a I of the actual value. If you modify the result, the set will not be modified. =item * span Returns the total span of the set, as a C object. =item * iterator / next / previous These methods can be used to iterate over the datetimes in a set. $iter = $set1->iterator; while ( $dt = $iter->next ) { print $dt->ymd; } # iterate backwards $iter = $set1->iterator; while ( $dt = $iter->previous ) { print $dt->ymd; } The boundaries of the iterator can be limited by passing it a C parameter. This should be a C object which delimits the iterator's boundaries. Optionally, instead of passing an object, you can pass any parameters that would work for one of the C class's constructors, and an object will be created for you. Obviously, if the span you specify is not restricted both at the start and end, then your iterator may iterate forever, depending on the nature of your set. User beware! The C or C method will return C when there are no more datetimes in the iterator. =item * as_list Returns the set elements as a list of C objects. Just as with the C method, the C method can be limited by a span. my @dt = $set->as_list( span => $span ); Applying C to a large recurrence set is a very expensive operation, both in CPU time and in the memory used. If you I need to extract elements from a large set, you can limit the set with a shorter span: my @short_list = $large_set->as_list( span => $short_span ); For I sets, C will return C. Please note that this is explicitly not an empty list, since an empty list is a valid return value for empty sets! =item * count Returns a count of C objects in the set. Just as with the C method, the C method can be limited by a span. defined( my $n = $set->count) or die "can't count"; my $n = $set->count( span => $span ); die "can't count" unless defined $n; Applying C to a large recurrence set is a very expensive operation, both in CPU time and in the memory used. If you I need to count elements from a large set, you can limit the set with a shorter span: my $count = $large_set->count( span => $short_span ); For I sets, C will return C. Please note that this is explicitly not a scalar zero, since a zero count is a valid return value for empty sets! =item * union =item * intersection =item * complement These set operation methods can accept a C list, a C, a C, or a C object as an argument. $set = $set1->union( $set2 ); # like "OR", "insert", "both" $set = $set1->complement( $set2 ); # like "delete", "remove" $set = $set1->intersection( $set2 ); # like "AND", "while" $set = $set1->complement; # like "NOT", "negate", "invert" The C of a C with a C or a C object returns a C object. If C is called without any arguments, then the result is a C object representing the spans between each of the set's elements. If complement is given an argument, then the return value is a C object representing the I between the sets. All other operations will always return a C. =item * intersects =item * contains These set operations result in a boolean value. if ( $set1->intersects( $set2 ) ) { ... # like "touches", "interferes" if ( $set1->contains( $dt ) ) { ... # like "is-fully-inside" These methods can accept a C list, a C, a C, or a C object as an argument. intersects() returns 1 for true, and 0 for false. In a few cases the algorithm can't decide if the sets intersect at all, and intersects() will return C. =item * previous =item * next =item * current =item * closest my $dt = $set->next( $dt ); my $dt = $set->previous( $dt ); my $dt = $set->current( $dt ); my $dt = $set->closest( $dt ); These methods are used to find a set member relative to a given datetime. The C method returns C<$dt> if $dt is an event, otherwise it returns the previous event. The C method returns C<$dt> if $dt is an event, otherwise it returns the closest event (previous or next). All of these methods may return C if there is no matching datetime in the set. These methods will try to set the returned value to the same time zone as the argument, unless the argument has a 'floating' time zone. =item * map ( sub { ... } ) # example: remove the hour:minute:second information $set = $set2->map( sub { return $_->truncate( to => day ); } ); # example: postpone or antecipate events which # match datetimes within another set $set = $set2->map( sub { return $_->add( days => 1 ) while $holidays->contains( $_ ); } ); This method is the "set" version of Perl "map". It evaluates a subroutine for each element of the set (locally setting "$_" to each datetime) and returns the set composed of the results of each such evaluation. Like Perl "map", each element of the set may produce zero, one, or more elements in the returned value. Unlike Perl "map", changing "$_" does not change the original set. This means that calling map in void context has no effect. The callback subroutine may be called later in the program, due to lazy evaluation. So don't count on subroutine side-effects. For example, a C inside the subroutine may happen later than you expect. The callback return value is expected to be within the span of the C and the C element in the original set. This is a limitation of the backtracking algorithm used in the C library. For example: given the set C<[ 2001, 2010, 2015 ]>, the callback result for the value C<2010> is expected to be within the span C<[ 2001 .. 2015 ]>. =item * grep ( sub { ... } ) # example: filter out any sundays $set = $set2->grep( sub { return ( $_->day_of_week != 7 ); } ); This method is the "set" version of Perl "grep". It evaluates a subroutine for each element of the set (locally setting "$_" to each datetime) and returns the set consisting of those elements for which the expression evaluated to true. Unlike Perl "grep", changing "$_" does not change the original set. This means that calling grep in void context has no effect. Changing "$_" does change the resulting set. The callback subroutine may be called later in the program, due to lazy evaluation. So don't count on subroutine side-effects. For example, a C inside the subroutine may happen later than you expect. =item * iterate ( sub { ... } ) I =back =head1 SUPPORT Support is offered through the C mailing list. Please report bugs using rt.cpan.org =head1 AUTHOR Flavio Soibelmann Glock The API was developed together with Dave Rolsky and the DateTime Community. =head1 COPYRIGHT Copyright (c) 2003-2006 Flavio Soibelmann Glock. All rights reserved. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO Set::Infinite For details on the Perl DateTime Suite project please see L. =cut DateTime-Set-0.3900/lib/DateTime/SpanSet.pm0000644000175000017500000006460012776372742017532 0ustar fglockfglock# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package DateTime::SpanSet; use strict; use DateTime::Set; use DateTime::Infinite; use Carp; use Params::Validate qw( validate SCALAR BOOLEAN OBJECT CODEREF ARRAYREF ); use vars qw( $VERSION ); use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); $VERSION = $DateTime::Set::VERSION; sub iterate { my ( $self, $callback ) = @_; my $class = ref( $self ); my $return = $class->empty_set; $return->{set} = $self->{set}->iterate( sub { my $span = bless { set => $_[0] }, 'DateTime::Span'; $callback->( $span->clone ); $span = $span->{set} if UNIVERSAL::can( $span, 'union' ); return $span; } ); $return; } sub map { my ( $self, $callback ) = @_; my $class = ref( $self ); die "The callback parameter to map() must be a subroutine reference" unless ref( $callback ) eq 'CODE'; my $return = $class->empty_set; $return->{set} = $self->{set}->iterate( sub { local $_ = bless { set => $_[0]->clone }, 'DateTime::Span'; my @list = $callback->(); my $set = $class->empty_set; $set = $set->union( $_ ) for @list; return $set->{set}; } ); $return; } sub grep { my ( $self, $callback ) = @_; my $class = ref( $self ); die "The callback parameter to grep() must be a subroutine reference" unless ref( $callback ) eq 'CODE'; my $return = $class->empty_set; $return->{set} = $self->{set}->iterate( sub { local $_ = bless { set => $_[0]->clone }, 'DateTime::Span'; my $result = $callback->(); return $_->{set} if $result && $_; return; } ); $return; } sub set_time_zone { my ( $self, $tz ) = @_; # TODO - use iterate() instead my $result = $self->{set}->iterate( sub { my %tmp = %{ $_[0]->{list}[0] }; $tmp{a} = $tmp{a}->clone->set_time_zone( $tz ) if ref $tmp{a}; $tmp{b} = $tmp{b}->clone->set_time_zone( $tz ) if ref $tmp{b}; \%tmp; }, backtrack_callback => sub { my ( $min, $max ) = ( $_[0]->min, $_[0]->max ); if ( ref($min) ) { $min = $min->clone; $min->set_time_zone( 'floating' ); } if ( ref($max) ) { $max = $max->clone; $max->set_time_zone( 'floating' ); } return Set::Infinite::_recurrence->new( $min, $max ); }, ); ### this code enables 'subroutine method' behaviour $self->{set} = $result; return $self; } sub from_spans { my $class = shift; my %args = validate( @_, { spans => { type => ARRAYREF, optional => 1, }, } ); my $self = {}; my $set = Set::Infinite::_recurrence->new(); $set = $set->union( $_->{set} ) for @{ $args{spans} }; $self->{set} = $set; bless $self, $class; return $self; } sub from_set_and_duration { # set => $dt_set, days => 1 my $class = shift; my %args = @_; my $set = delete $args{set} || carp "from_set_and_duration needs a 'set' parameter"; $set = $set->as_set if UNIVERSAL::can( $set, 'as_set' ); unless ( UNIVERSAL::can( $set, 'union' ) ) { carp "'set' must be a set" }; my $duration = delete $args{duration} || new DateTime::Duration( %args ); my $end_set = $set->clone->add_duration( $duration ); return $class->from_sets( start_set => $set, end_set => $end_set ); } sub from_sets { my $class = shift; my %args = validate( @_, { start_set => { # can => 'union', optional => 0, }, end_set => { # can => 'union', optional => 0, }, } ); my $start_set = delete $args{start_set}; my $end_set = delete $args{end_set}; $start_set = $start_set->as_set if UNIVERSAL::can( $start_set, 'as_set' ); $end_set = $end_set->as_set if UNIVERSAL::can( $end_set, 'as_set' ); unless ( UNIVERSAL::can( $start_set, 'union' ) ) { carp "'start_set' must be a set" }; unless ( UNIVERSAL::can( $end_set, 'union' ) ) { carp "'end_set' must be a set" }; my $self; $self->{set} = $start_set->{set}->until( $end_set->{set} ); bless $self, $class; return $self; } sub start_set { if ( exists $_[0]->{set}{method} && $_[0]->{set}{method} eq 'until' ) { return bless { set => $_[0]->{set}{parent}[0] }, 'DateTime::Set'; } my $return = DateTime::Set->empty_set; $return->{set} = $_[0]->{set}->start_set; $return; } sub end_set { if ( exists $_[0]->{set}{method} && $_[0]->{set}{method} eq 'until' ) { return bless { set => $_[0]->{set}{parent}[1] }, 'DateTime::Set'; } my $return = DateTime::Set->empty_set; $return->{set} = $_[0]->{set}->end_set; $return; } sub empty_set { my $class = shift; return bless { set => Set::Infinite::_recurrence->new }, $class; } sub is_empty_set { my $set = $_[0]; $set->{set}->is_null; } sub clone { bless { set => $_[0]->{set}->copy, }, ref $_[0]; } sub iterator { my $self = shift; my %args = @_; my $span; $span = delete $args{span}; $span = DateTime::Span->new( %args ) if %args; return $self->intersection( $span ) if $span; return $self->clone; } # next() gets the next element from an iterator() sub next { my ($self) = shift; # TODO: this is fixing an error from elsewhere # - find out what's going on! (with "sunset.pl") return undef unless ref $self->{set}; if ( @_ ) { my $max; $max = $_[0]->max if UNIVERSAL::can( $_[0], 'union' ); $max = $_[0] if ! defined $max; return undef if ! ref( $max ) && $max == INFINITY; my $span = DateTime::Span->from_datetimes( start => $max ); my $iterator = $self->intersection( $span ); my $return = $iterator->next; return $return if ! defined $return; return $return if ! $return->intersects( $max ); return $iterator->next; } my ($head, $tail) = $self->{set}->first; $self->{set} = $tail; return $head unless ref $head; my $return = { set => $head, }; bless $return, 'DateTime::Span'; return $return; } # previous() gets the last element from an iterator() sub previous { my ($self) = shift; return undef unless ref $self->{set}; if ( @_ ) { my $min; $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' ); $min = $_[0] if ! defined $min; return undef if ! ref( $min ) && $min == INFINITY; my $span = DateTime::Span->from_datetimes( end => $min ); my $iterator = $self->intersection( $span ); my $return = $iterator->previous; return $return if ! defined $return; return $return if ! $return->intersects( $min ); return $iterator->previous; } my ($head, $tail) = $self->{set}->last; $self->{set} = $tail; return $head unless ref $head; my $return = { set => $head, }; bless $return, 'DateTime::Span'; return $return; } # "current" means less-or-equal to a DateTime sub current { my $self = shift; my $previous; my $next; { my $min; $min = $_[0]->min if UNIVERSAL::can( $_[0], 'union' ); $min = $_[0] if ! defined $min; return undef if ! ref( $min ) && $min == INFINITY; my $span = DateTime::Span->from_datetimes( end => $min ); my $iterator = $self->intersection( $span ); $previous = $iterator->previous; $span = DateTime::Span->from_datetimes( start => $min ); $iterator = $self->intersection( $span ); $next = $iterator->next; } return $previous unless defined $next; my $dt1 = defined $previous ? $next->union( $previous ) : $next; my $return = $dt1->intersected_spans( $_[0] ); $return = $previous if !defined $return->max; bless $return, 'DateTime::SpanSet' if defined $return; return $return; } sub closest { my $self = shift; my $dt = shift; my $dt1 = $self->current( $dt ); my $dt2 = $self->next( $dt ); bless $dt2, 'DateTime::SpanSet' if defined $dt2; return $dt2 unless defined $dt1; return $dt1 unless defined $dt2; $dt = DateTime::Set->from_datetimes( dates => [ $dt ] ) unless UNIVERSAL::can( $dt, 'union' ); return $dt1 if $dt1->contains( $dt ); my $delta = $dt->min - $dt1->max; return $dt1 if ( $dt2->min - $delta ) >= $dt->max; return $dt2; } sub as_list { my $self = shift; return undef unless ref( $self->{set} ); my %args = @_; my $span; $span = delete $args{span}; $span = DateTime::Span->new( %args ) if %args; my $set = $self->clone; $set = $set->intersection( $span ) if $span; # Note: removing this line means we may end up in an infinite loop! return undef if $set->{set}->is_too_complex; # undef = no start/end # return if $set->{set}->is_null; # nothing = empty my @result; # we should extract _copies_ of the set elements, # such that the user can't modify the set indirectly my $iter = $set->iterator; while ( my $dt = $iter->next ) { push @result, $dt if ref( $dt ); # we don't want to return INFINITY value }; return @result; } # Set::Infinite methods sub intersection { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); my $tmp = $class->empty_set(); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->intersection( $set2->{set} ); return $tmp; } sub intersected_spans { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); my $tmp = $class->empty_set(); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->intersected_spans( $set2->{set} ); return $tmp; } sub intersects { my ($set1, $set2) = ( shift, shift ); unless ( $set2->can( 'union' ) ) { for ( $set2, @_ ) { return 1 if $set1->contains( $_ ); } return 0; } my $class = ref($set1); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); return $set1->{set}->intersects( $set2->{set} ); } sub contains { my ($set1, $set2) = ( shift, shift ); unless ( $set2->can( 'union' ) ) { if ( exists $set1->{set}{method} && $set1->{set}{method} eq 'until' ) { my $start_set = $set1->start_set; my $end_set = $set1->end_set; for ( $set2, @_ ) { my $start = $start_set->next( $set2 ); my $end = $end_set->next( $set2 ); goto ABORT unless defined $start && defined $end; return 0 if $start < $end; } return 1; ABORT: ; # don't know } } my $class = ref($set1); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); return $set1->{set}->contains( $set2->{set} ); } sub union { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); my $tmp = $class->empty_set(); $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->union( $set2->{set} ); return $tmp; } sub complement { my ($set1, $set2) = ( shift, shift ); my $class = ref($set1); my $tmp = $class->empty_set(); if (defined $set2) { $set2 = $set2->as_spanset if $set2->can( 'as_spanset' ); $set2 = $set2->as_set if $set2->can( 'as_set' ); $set2 = DateTime::Set->from_datetimes( dates => [ $set2, @_ ] ) unless $set2->can( 'union' ); $tmp->{set} = $set1->{set}->complement( $set2->{set} ); } else { $tmp->{set} = $set1->{set}->complement; } return $tmp; } sub start { return DateTime::Set::_fix_datetime( $_[0]->{set}->min ); } *min = \&start; sub end { return DateTime::Set::_fix_datetime( $_[0]->{set}->max ); } *max = \&end; # returns a DateTime::Span sub span { my $set = $_[0]->{set}->span; my $self = bless { set => $set }, 'DateTime::Span'; return $self; } # returns a DateTime::Duration sub duration { my $dur; return DateTime::Duration->new( seconds => 0 ) if $_[0]->{set}->is_empty; local $@; eval { local $SIG{__DIE__}; # don't want to trap this (rt ticket 5434) $dur = $_[0]->{set}->size }; return $dur if defined $dur && ref( $dur ); return DateTime::Infinite::Future->new - DateTime::Infinite::Past->new; # return INFINITY; } *size = \&duration; 1; __END__ =head1 NAME DateTime::SpanSet - set of DateTime spans =head1 SYNOPSIS $spanset = DateTime::SpanSet->from_spans( spans => [ $dt_span, $dt_span ] ); $set = $spanset->union( $set2 ); # like "OR", "insert", "both" $set = $spanset->complement( $set2 ); # like "delete", "remove" $set = $spanset->intersection( $set2 ); # like "AND", "while" $set = $spanset->complement; # like "NOT", "negate", "invert" if ( $spanset->intersects( $set2 ) ) { ... # like "touches", "interferes" if ( $spanset->contains( $set2 ) ) { ... # like "is-fully-inside" # data extraction $date = $spanset->min; # first date of the set $date = $spanset->max; # last date of the set $iter = $spanset->iterator; while ( $dt = $iter->next ) { # $dt is a DateTime::Span print $dt->start->ymd; # first date of span print $dt->end->ymd; # last date of span }; =head1 DESCRIPTION C is a class that represents sets of datetime spans. An example would be a recurring meeting that occurs from 13:00-15:00 every Friday. This is different from a C, which is made of individual datetime points as opposed to ranges. =head1 METHODS =over 4 =item * from_spans Creates a new span set from one or more C objects. $spanset = DateTime::SpanSet->from_spans( spans => [ $dt_span ] ); =item * from_set_and_duration Creates a new span set from one or more C objects and a duration. The duration can be a C object, or the parameters to create a new C object, such as "days", "months", etc. $spanset = DateTime::SpanSet->from_set_and_duration ( set => $dt_set, days => 1 ); =item * from_sets Creates a new span set from two C objects. One set defines the I, and the other defines the I. $spanset = DateTime::SpanSet->from_sets ( start_set => $dt_set1, end_set => $dt_set2 ); The spans have the starting date C, and the end date C, like in C<[$dt1, $dt2)>. If an end date comes without a starting date before it, then it defines a span like C<(-inf, $dt)>. If a starting date comes without an end date after it, then it defines a span like C<[$dt, inf)>. =item * empty_set Creates a new empty set. =item * is_empty_set Returns true is the set is empty; false otherwise. print "nothing" if $set->is_empty_set; =item * clone This object method returns a replica of the given object. =item * set_time_zone( $tz ) This method accepts either a time zone object or a string that can be passed as the "name" parameter to C<< DateTime::TimeZone->new() >>. If the new time zone's offset is different from the old time zone, then the I time is adjusted accordingly. If the old time zone was a floating time zone, then no adjustments to the local time are made, except to account for leap seconds. If the new time zone is floating, then the I time is adjusted in order to leave the local time untouched. =item * start, min =item * end, max First or last dates in the set. It is possible that the return value from these methods may be a C or a C object. If the set ends C a date C<$dt>, it returns C<$dt>. Note that in this case C<$dt> is not a set element - but it is a set boundary. These methods may return C if the set is empty. These methods return just a I of the actual boundary value. If you modify the result, the set will not be modified. =item * duration The total size of the set, as a C object. The duration may be infinite. Also available as C. =item * span The total span of the set, as a C object. =item * next my $span = $set->next( $dt ); This method is used to find the next span in the set, after a given datetime or span. The return value is a C, or C if there is no matching span in the set. =item * previous my $span = $set->previous( $dt ); This method is used to find the previous span in the set, before a given datetime or span. The return value is a C, or C if there is no matching span in the set. =item * current my $span = $set->current( $dt ); This method is used to find the "current" span in the set, that intersects a given datetime or span. If no current span is found, then the "previous" span is returned. The return value is a C, or C if there is no matching span in the set. If a span parameter is given, it may happen that "current" returns more than one span. See also: C method. =item * closest my $span = $set->closest( $dt ); This method is used to find the "closest" span in the set, given a datetime or span. The return value is a C, or C if the set is empty. If a span parameter is given, it may happen that "closest" returns more than one span. =item * as_list Returns a list of C objects. my @dt_span = $set->as_list( span => $span ); Just as with the C method, the C method can be limited by a span. Applying C to a large recurring spanset is a very expensive operation, both in CPU time and in the memory used. For this reason, when C operates on large recurrence sets, it will return at most approximately 200 spans. For larger sets, and for I sets, C will return C. Please note that this is explicitly not an empty list, since an empty list is a valid return value for empty sets! If you I need to extract spans from a large set, you can: - limit the set with a shorter span: my @short_list = $large_set->as_list( span => $short_span ); - use an iterator: my @large_list; my $iter = $large_set->iterator; push @large_list, $dt while $dt = $iter->next; =item * union =item * intersection =item * complement Set operations may be performed not only with C objects, but also with C, C and C objects. These set operations always return a C object. $set = $spanset->union( $set2 ); # like "OR", "insert", "both" $set = $spanset->complement( $set2 ); # like "delete", "remove" $set = $spanset->intersection( $set2 ); # like "AND", "while" $set = $spanset->complement; # like "NOT", "negate", "invert" =item * intersected_spans This method can accept a C list, a C, a C, or a C object as an argument. $set = $set1->intersected_spans( $set2 ); The method always returns a C object, containing all spans that are intersected by the given set. Unlike the C method, the spans are not modified. See diagram below: set1 [....] [....] [....] [....] set2 [................] intersection [.] [....] [.] intersected_spans [....] [....] [....] =item * intersects =item * contains These set functions return a boolean value. if ( $spanset->intersects( $set2 ) ) { ... # like "touches", "interferes" if ( $spanset->contains( $dt ) ) { ... # like "is-fully-inside" These methods can accept a C, C, C, or C object as an argument. intersects() returns 1 for true, and 0 for false. In a few cases the algorithm can't decide if the sets intersect at all, and intersects() will return C. =item * iterator / next / previous This method can be used to iterate over the spans in a set. $iter = $spanset->iterator; while ( $dt = $iter->next ) { # $dt is a DateTime::Span print $dt->min->ymd; # first date of span print $dt->max->ymd; # last date of span } The boundaries of the iterator can be limited by passing it a C parameter. This should be a C object which delimits the iterator's boundaries. Optionally, instead of passing an object, you can pass any parameters that would work for one of the C class's constructors, and an object will be created for you. Obviously, if the span you specify does is not restricted both at the start and end, then your iterator may iterate forever, depending on the nature of your set. User beware! The C or C methods will return C when there are no more spans in the iterator. =item * start_set =item * end_set These methods do the inverse of the C method: C retrieves a DateTime::Set with the start datetime of each span. C retrieves a DateTime::Set with the end datetime of each span. =item * map ( sub { ... } ) # example: enlarge the spans $set = $set2->map( sub { my $start = $_->start; my $end = $_->end; return DateTime::Span->from_datetimes( start => $start, before => $end, ); } ); This method is the "set" version of Perl "map". It evaluates a subroutine for each element of the set (locally setting "$_" to each DateTime::Span) and returns the set composed of the results of each such evaluation. Like Perl "map", each element of the set may produce zero, one, or more elements in the returned value. Unlike Perl "map", changing "$_" does not change the original set. This means that calling map in void context has no effect. The callback subroutine may not be called immediately. Don't count on subroutine side-effects. For example, a C inside the subroutine may happen later than you expect. The callback return value is expected to be within the span of the C and the C element in the original set. For example: given the set C<[ 2001, 2010, 2015 ]>, the callback result for the value C<2010> is expected to be within the span C<[ 2001 .. 2015 ]>. =item * grep ( sub { ... } ) # example: filter out all spans happening today my $today = DateTime->today; $set = $set2->grep( sub { return ( ! $_->contains( $today ) ); } ); This method is the "set" version of Perl "grep". It evaluates a subroutine for each element of the set (locally setting "$_" to each DateTime::Span) and returns the set consisting of those elements for which the expression evaluated to true. Unlike Perl "grep", changing "$_" does not change the original set. This means that calling grep in void context has no effect. Changing "$_" does change the resulting set. The callback subroutine may not be called immediately. Don't count on subroutine side-effects. For example, a C inside the subroutine may happen later than you expect. =item * iterate I This function apply a callback subroutine to all elements of a set and returns the resulting set. The parameter C<$_[0]> to the callback subroutine is a C object. If the callback returns C, the datetime is removed from the set: sub remove_sundays { $_[0] unless $_[0]->start->day_of_week == 7; } The callback return value is expected to be within the span of the C and the C element in the original set. For example: given the set C<[ 2001, 2010, 2015 ]>, the callback result for the value C<2010> is expected to be within the span C<[ 2001 .. 2015 ]>. The callback subroutine may not be called immediately. Don't count on subroutine side-effects. For example, a C inside the subroutine may happen later than you expect. =back =head1 SUPPORT Support is offered through the C mailing list. Please report bugs using rt.cpan.org =head1 AUTHOR Flavio Soibelmann Glock The API was developed together with Dave Rolsky and the DateTime Community. =head1 COPYRIGHT Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO Set::Infinite For details on the Perl DateTime Suite project please see L. =cut DateTime-Set-0.3900/lib/Set/0000755000175000017500000000000012776373427014651 5ustar fglockfglockDateTime-Set-0.3900/lib/Set/Infinite/0000755000175000017500000000000012776373427016416 5ustar fglockfglockDateTime-Set-0.3900/lib/Set/Infinite/_recurrence.pm0000644000175000017500000003075412776372742021260 0ustar fglockfglock# Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Set::Infinite::_recurrence; use strict; use constant INFINITY => 100 ** 100 ** 100 ; use constant NEG_INFINITY => -1 * (100 ** 100 ** 100); use vars qw( @ISA $PRETTY_PRINT $max_iterate ); @ISA = qw( Set::Infinite ); use Set::Infinite 0.5502; BEGIN { $PRETTY_PRINT = 1; # enable Set::Infinite debug $max_iterate = 20; # TODO: inherit %Set::Infinite::_first / _last # in a more "object oriented" way $Set::Infinite::_first{_recurrence} = sub { my $self = $_[0]; my ($callback_next, $callback_previous) = @{ $self->{param} }; my ($min, $min_open) = $self->{parent}->min_a; # my ($max, $max_open) = $self->{parent}->max_a; my ( $min1, $min2 ); $min1 = $callback_next->( $min ); if ( ! $min_open ) { $min2 = $callback_previous->( $min1 ); $min1 = $min2 if defined $min2 && $min == $min2; } my $start = $callback_next->( $min1 ); my $end = $self->{parent}->max; #print STDERR "set "; #print STDERR $start->datetime # unless $start == INFINITY; #print STDERR " - " ; #print STDERR $end->datetime # unless $end == INFINITY; #print STDERR "\n"; return ( $self->new( $min1 ), undef ) if $start > $end; return ( $self->new( $min1 ), $self->new( $start, $end )-> # $self->new( {a => $start, b => $end, open_end => $max_open} )-> _function( '_recurrence', @{ $self->{param} } ) ); }; $Set::Infinite::_last{_recurrence} = sub { my $self = $_[0]; my ($callback_next, $callback_previous) = @{ $self->{param} }; my ($max, $max_open) = $self->{parent}->max_a; my ( $max1, $max2 ); $max1 = $callback_previous->( $max ); if ( ! $max_open ) { $max2 = $callback_next->( $max1 ); $max1 = $max2 if $max == $max2; } return ( $self->new( $max1 ), $self->new( $self->{parent}->min, $callback_previous->( $max1 ) )-> _function( '_recurrence', @{ $self->{param} } ) ); }; } # $si->_recurrence( # \&callback_next, \&callback_previous ) # # Generates "recurrences" from a callback. # These recurrences are simple lists of dates. # # The recurrence generation is based on an idea from Dave Rolsky. # # use Data::Dumper; # use Carp qw(cluck); sub _recurrence { my $set = shift; my ( $callback_next, $callback_previous, $delta ) = @_; $delta->{count} = 0 unless defined $delta->{delta}; # warn "reusing delta: ". $delta->{count} if defined $delta->{delta}; # warn Dumper( $delta ); if ( $#{ $set->{list} } != 0 || $set->is_too_complex ) { return $set->iterate( sub { $_[0]->_recurrence( $callback_next, $callback_previous, $delta ) } ); } # $set is a span my $result; if ($set->min != NEG_INFINITY && $set->max != INFINITY) { # print STDERR " finite set\n"; my ($min, $min_open) = $set->min_a; my ($max, $max_open) = $set->max_a; my ( $min1, $min2 ); $min1 = $callback_next->( $min ); if ( ! $min_open ) { $min2 = $callback_previous->( $min1 ); $min1 = $min2 if defined $min2 && $min == $min2; } $result = $set->new(); # get "delta" - abort if this will take too much time. unless ( defined $delta->{max_delta} ) { for ( $delta->{count} .. 10 ) { if ( $max_open ) { return $result if $min1 >= $max; } else { return $result if $min1 > $max; } push @{ $result->{list} }, { a => $min1, b => $min1, open_begin => 0, open_end => 0 }; $min2 = $callback_next->( $min1 ); if ( $delta->{delta} ) { $delta->{delta} += $min2 - $min1; } else { $delta->{delta} = $min2 - $min1; } $delta->{count}++; $min1 = $min2; } $delta->{max_delta} = $delta->{delta} * 40; } if ( $max < $min + $delta->{max_delta} ) { for ( 1 .. 200 ) { if ( $max_open ) { return $result if $min1 >= $max; } else { return $result if $min1 > $max; } push @{ $result->{list} }, { a => $min1, b => $min1, open_begin => 0, open_end => 0 }; $min1 = $callback_next->( $min1 ); } } # cluck "give up"; } # return a "_function", such that we can backtrack later. my $func = $set->_function( '_recurrence', $callback_next, $callback_previous, $delta ); # removed - returning $result doesn't help on speed ## return $func->_function2( 'union', $result ) if $result; return $func; } sub is_forever { $#{ $_[0]->{list} } == 0 && $_[0]->max == INFINITY && $_[0]->min == NEG_INFINITY } sub _is_recurrence { exists $_[0]->{method} && $_[0]->{method} eq '_recurrence' && $_[0]->{parent}->is_forever } sub intersects { my ($s1, $s2) = (shift,shift); if ( exists $s1->{method} && $s1->{method} eq '_recurrence' ) { # recurrence && span unless ( ref($s2) && exists $s2->{method} ) { my $intersection = $s1->intersection($s2, @_); my $min = $intersection->min; return 1 if defined $min && $min != NEG_INFINITY && $min != INFINITY; my $max = $intersection->max; return 1 if defined $max && $max != NEG_INFINITY && $max != INFINITY; } # recurrence && recurrence if ( $s1->{parent}->is_forever && ref($s2) && _is_recurrence( $s2 ) ) { my $intersection = $s1->intersection($s2, @_); my $min = $intersection->min; return 1 if defined $min && $min != NEG_INFINITY && $min != INFINITY; my $max = $intersection->max; return 1 if defined $max && $max != NEG_INFINITY && $max != INFINITY; } } return $s1->SUPER::intersects( $s2, @_ ); } sub intersection { my ($s1, $s2) = (shift,shift); if ( exists $s1->{method} && $s1->{method} eq '_recurrence' ) { # optimize: recurrence && span return $s1->{parent}-> intersection( $s2, @_ )-> _recurrence( @{ $s1->{param} } ) unless ref($s2) && exists $s2->{method}; # optimize: recurrence && recurrence if ( $s1->{parent}->is_forever && ref($s2) && _is_recurrence( $s2 ) ) { my ( $next1, $previous1 ) = @{ $s1->{param} }; my ( $next2, $previous2 ) = @{ $s2->{param} }; return $s1->{parent}->_function( '_recurrence', sub { # intersection of parent 'next' callbacks my ($n1, $n2); my $iterate = 0; $n2 = $next2->( $_[0] ); while(1) { $n1 = $next1->( $previous1->( $n2 ) ); return $n1 if $n1 == $n2; $n2 = $next2->( $previous2->( $n1 ) ); return if $iterate++ == $max_iterate; } }, sub { # intersection of parent 'previous' callbacks my ($p1, $p2); my $iterate = 0; $p2 = $previous2->( $_[0] ); while(1) { $p1 = $previous1->( $next1->( $p2 ) ); return $p1 if $p1 == $p2; $p2 = $previous2->( $next2->( $p1 ) ); return if $iterate++ == $max_iterate; } }, ); } } return $s1->SUPER::intersection( $s2, @_ ); } sub union { my ($s1, $s2) = (shift,shift); if ( $s1->_is_recurrence && ref($s2) && _is_recurrence( $s2 ) ) { # optimize: recurrence || recurrence my ( $next1, $previous1 ) = @{ $s1->{param} }; my ( $next2, $previous2 ) = @{ $s2->{param} }; return $s1->{parent}->_function( '_recurrence', sub { # next my $n1 = $next1->( $_[0] ); my $n2 = $next2->( $_[0] ); return $n1 < $n2 ? $n1 : $n2; }, sub { # previous my $p1 = $previous1->( $_[0] ); my $p2 = $previous2->( $_[0] ); return $p1 > $p2 ? $p1 : $p2; }, ); } return $s1->SUPER::union( $s2, @_ ); } =head1 NAME Set::Infinite::_recurrence - Extends Set::Infinite with recurrence functions =head1 SYNOPSIS $recurrence = $base_set->_recurrence ( \&next, \&previous ); =head1 DESCRIPTION This is an internal class used by the DateTime::Set module. The API is subject to change. It provides all functionality provided by Set::Infinite, plus the ability to define recurrences with arbitrary objects, such as dates. =head1 METHODS =over 4 =item * _recurrence ( \&next, \&previous ) Creates a recurrence set. The set is defined inside a 'base set'. $recurrence = $base_set->_recurrence ( \&next, \&previous ); The recurrence functions take one argument, and return the 'next' or the 'previous' occurrence. Example: defines the set of all 'integer numbers': use strict; use Set::Infinite::_recurrence; use POSIX qw(floor); # define the recurrence span my $forever = Set::Infinite::_recurrence->new( Set::Infinite::_recurrence::NEG_INFINITY, Set::Infinite::_recurrence::INFINITY ); my $recurrence = $forever->_recurrence( sub { # next floor( $_[0] + 1 ) }, sub { # previous my $tmp = floor( $_[0] ); $tmp < $_[0] ? $tmp : $_[0] - 1 }, ); print "sample recurrence ", $recurrence->intersection( -5, 5 ), "\n"; # sample recurrence -5,-4,-3,-2,-1,0,1,2,3,4,5 { my $x = 234.567; print "next occurrence after $x = ", $recurrence->{param}[0]->( $x ), "\n"; # 235 print "previous occurrence before $x = ", $recurrence->{param}[2]->( $x ), "\n"; # 234 } { my $x = 234; print "next occurrence after $x = ", $recurrence->{param}[0]->( $x ), "\n"; # 235 print "previous occurrence before $x = ", $recurrence->{param}[2]->( $x ), "\n"; # 233 } =item * is_forever Returns true if the set is a single span, ranging from -Infinity to Infinity. =item * _is_recurrence Returns true if the set is an unbounded recurrence, ranging from -Infinity to Infinity. =back =head1 CONSTANTS =over 4 =item * INFINITY The C value. =item * NEG_INFINITY The C<-Infinity> value. =back =head1 SUPPORT Support is offered through the C mailing list. Please report bugs using rt.cpan.org =head1 AUTHOR Flavio Soibelmann Glock The recurrence generation algorithm is based on an idea from Dave Rolsky. =head1 COPYRIGHT Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved. This program is free software; you can distribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =head1 SEE ALSO Set::Infinite DateTime::Set For details on the Perl DateTime Suite project please see L. =cut DateTime-Set-0.3900/README0000644000175000017500000000061712776372742014233 0ustar fglockfglockOVERVIEW The DateTime::Set module provides a date/time sets implementation. It allows, for example, the generation of groups of dates, like "every wednesday", and then find all the dates matching that pattern, within a time range. INSTALLATION To install this module type the following in the distribution directory: perl Build.PL perl Build perl Build test perl Build install DateTime-Set-0.3900/Makefile.PL0000644000175000017500000000437612776373034015326 0ustar fglockfglockuse strict; use ExtUtils::MakeMaker; use vars qw( %conflicts $has_conflicts ); sub conflicts { my ( $module, $version ) = @_; eval "use $module"; my $module_version = eval "\$".$module."::VERSION"; if ( defined $module_version && $module_version < $version ) { warn " * ERROR: This version of DateTime::Set conflicts with\n". " installed module \"$module\" Version \"$module_version\"\n"; $has_conflicts = 1; } } %conflicts = ( 'DateTime::Event::Recurrence' => '0.10', 'DateTime::Event::ICal' => '0.07', 'DateTime::Event::Random' => '0.03', 'DateTime::Event::Cron' => '0.0601', 'DateTime::Event::Sunrise' => '0.0501', # cvs ok; CPAN not ok 'DateTime::Event::Chinese' => '0', # untested 'DateTime::Event::Lunar' => '0', # untested 'DateTime::Event::SolarTerm' => '0', # untested ); $has_conflicts = 0; for ( keys %conflicts ) { conflicts ( $_, $conflicts{$_} ); } if ( $has_conflicts ) { warn "ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to update the versions\n". "of the modules indicated above before proceeding with this installation.\n\n"; } WriteMakefile( NAME => 'DateTime::Set', VERSION_FROM => 'lib/DateTime/Set.pm', AUTHOR => 'Flavio S. Glock ', ABSTRACT => 'DateTime set objects', PREREQ_PM => { 'DateTime' => 0.12, 'Set::Infinite' => 0.59, 'Test::More' => 0, 'Params::Validate' => 0, }, PL_FILES => { }, # ignore Build.PL META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/fglock/DateTime-Set.git', web => 'https://github.com/fglock/DateTime-Set', }, }, }, );