├── .gitignore ├── .travis.yml ├── Changes ├── MANIFEST.SKIP ├── Makefile.PL ├── Moment.xs ├── dev ├── bench.pl └── sizeof.pl ├── eg ├── age.pl ├── ago.pl ├── beat.pl ├── cal.pl ├── cbor.pl ├── clocks.pl ├── excel.pl ├── json.pl ├── se_bank_holidays.pl ├── sereal.pl ├── strftime.pl └── us_federal_holidays.pl ├── lib └── Time │ ├── Moment.pm │ ├── Moment.pod │ └── Moment │ ├── Adjusters.pm │ └── Adjusters.pod ├── src ├── dt_accessor.c ├── dt_accessor.h ├── dt_arithmetic.c ├── dt_arithmetic.h ├── dt_config.h ├── dt_core.c ├── dt_core.h ├── dt_easter.c ├── dt_easter.h ├── dt_length.c ├── dt_length.h ├── dt_parse_iso.c ├── dt_parse_iso.h ├── dt_util.c ├── dt_util.h ├── dt_valid.c ├── dt_valid.h ├── moment.c ├── moment.h ├── moment_fmt.c ├── moment_fmt.h ├── moment_parse.c └── moment_parse.h ├── t ├── 000_load.t ├── 100_basic.t ├── 110_now.t ├── 120_now_utc.t ├── 130_from_epoch.t ├── 140_from_object.t ├── 145_from_object_tp.t ├── 150_from_object_dt.t ├── 180_from_string.t ├── 190_rd.t ├── 191_jd.t ├── 192_mjd.t ├── 200_compare.t ├── 300_strftime.t ├── 400_with.t ├── 410_with_offset.t ├── 411_with_adjusters.t ├── 415_precision.t ├── 420_at.t ├── 430_length.t ├── 450_delta_time.t ├── 455_delta_date.t ├── 500_storable.t ├── 510_json.t ├── 520_cbor.t ├── 530_sereal.t ├── 600_coerce_dt.t ├── 610_coerce_tp.t ├── 900_bug_reuse.t └── Util.pm └── typemap /.gitignore: -------------------------------------------------------------------------------- 1 | *.com 2 | *.class 3 | *.dll 4 | *.exe 5 | *.o 6 | *.so 7 | *.bak 8 | *.old 9 | *.tmp 10 | *.tar.gz 11 | *.rej 12 | *.orig 13 | *~ 14 | .DS_Store 15 | .DS_Store? 16 | ._* 17 | .Spotlight-V100 18 | .Trashes 19 | Icon 20 | /.build 21 | /Build 22 | /Build.bat 23 | /Makefile 24 | /_build 25 | /blib 26 | /cover_db 27 | /pm_to_blib 28 | /PM_to_blib 29 | /MYMETA.yml 30 | /MYMETA.json 31 | /Time-Moment-* 32 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | - "5.24" 4 | - "5.22" 5 | - "5.20" 6 | - "5.18" 7 | - "5.16" 8 | - "5.14" 9 | - "5.12" 10 | - "5.10" 11 | before_install: 12 | - "cpanm Module::Install" 13 | - "cpanm Module::Install::XSUtil" 14 | - "cpanm Module::Install::ReadmeFromPod" 15 | - "cpanm Test::More" 16 | - "cpanm Test::Fatal" 17 | - "cpanm Test::Requires" 18 | - "cpanm Test::Number::Delta" 19 | - "cpanm Sereal" 20 | - "cpanm Params::Coerce" 21 | script: "perl Makefile.PL; make test" 22 | 23 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | 0.45 2 | - Added a new documentation section explaining the fundamental differences 3 | between calendar units and time units, addressing issue #49. 4 | - Added a new documentation section on supported calendars, specifically detailing 5 | the ISO 8601 week date representation, addressing issue #21. 6 | - Updated documentation to fix incorrect conversion specifier in ISO 8601 examples, 7 | reported by Richlv in issue #45. 8 | - Resolved a Year 2038 bug in the ->now method, which would have occurred in 2038, 9 | by switching from 32-bit to 64-bit integers for second calculations. Addressed 10 | in PR #48 and issue #47 by Bernhard M. Wiedemann (@bmwiedemann). 11 | 12 | 0.44 2018-05-09 13 | - Bug fix in Time::Moment::Adjusters that prevented the export 14 | of OrthodoxEasterSunday(). Reported by David Romano (unobe) #29. 15 | - Bug fix in Time::Moment::Adjusters, the PreviousDayOfWeek() routine 16 | computed an incorrect value, fix by Simon Shine (sshine) and tests 17 | by Julien Fiegehenn (simbabque) and Simon Shine #31 and PR #32. 18 | 19 | 0.43 2018-03-08 20 | - Correct commification of epoch seconds in documentation. 21 | PR #26, by Tim Heaney (oylenshpeegul). 22 | - The macro test around the inclusion of stdbool.h was too broad and 23 | didn't account for compiler abilities. PR #28 by Dale Ghent (daleghent). 24 | 25 | 0.42 2017-04-10 26 | - Avoid relying on current working directory being in @INC 27 | 28 | 0.41 2016-12-10 29 | - Time::Moment 30 | - Documented the precision value returned by ->precision() 31 | - Documented the optional precision value in ->compare() 32 | - Time::Moment::Adjusters 33 | - Corrected the NearestMinuteInterval example 34 | - Increased and documented the accepted values for NearestMinuteInterval 35 | 36 | 0.40 2016-11-26 37 | - Correct forward function declaration to include interpreter context 38 | Bug fix for #22, compilation with threaded perls. Reported by 39 | Slaven Rezić (eserte). 40 | 41 | 0.39 2016-11-25 42 | - Added following methods to Time::Moment: 43 | - precision 44 | - with_precision 45 | - Added following adjusters to Time::Moment::Adjusters: 46 | - WesternEasterSunday() 47 | - OthodoxEasterSunday() 48 | - NearestMinuteInterval($interval) 49 | - Added following examples to eg/ 50 | - eg/se_bank_holidays.pl 51 | 52 | 0.38 2016-01-22 53 | - Added following methods to the API: 54 | - is_leap_year 55 | - Added following examples to eg/ 56 | - eg/age.pl 57 | 58 | 0.37 2015-12-18 59 | - Added following methods to the API: 60 | - with_quarter 61 | - Clarified parts of documentation 62 | 63 | 0.36 2015-10-11 64 | - Applied patch from Vitaliy V. Tokarev (issue #15) which addresses build 65 | issues on Solaris with Sun Compiler. 66 | 67 | 0.35 2015-10-10 68 | - Added support for named parameters in from_epoch 69 | - Fix a compiler issue related to PERL_UNUSED_VAR(), reported by CPAN 70 | smokers, . 71 | 72 | 0.34 2015-10-10 73 | - This release has no code changes. Re-released without object files. 74 | 75 | 0.33 2015-10-10 76 | - Fixed a bug in from_rd, from_jd and from_mjd when Perl is compiled 77 | with long double. Reported by Slaven Rezić (SREZIC), issue #19. 78 | 79 | 0.32 2015-10-09 80 | - Added Test::Number::Delta v1.06 as a test prerequisite 81 | - Increased test coverage 82 | - Added following methods to the API: 83 | - from_rd 84 | 85 | 0.31 2015-09-28 86 | - Added following methods to the API: 87 | - delta_years 88 | - delta_months 89 | - delta_weeks 90 | - delta_days 91 | 92 | 0.30 2015-09-23 93 | - Fixed a bug in the delta methods that where added in previous release. The 94 | result should be negative if the other time is before the time of the 95 | invocant. 96 | - Added two examples to eg/ 97 | - eg/ago.pl 98 | - eg/beat.pl 99 | 100 | 0.29 2015-09-17 101 | - Changed the fractional second precision in from_epoch() when invoked with 102 | a floating point value from nanosecond precision to microsecond precision. 103 | - Changed the exception message in ->from_string(), from "Cannot parse ..." 104 | to "Could not parse ...". 105 | - Added following methods to the API: 106 | - delta_hours 107 | - delta_minutes 108 | - delta_seconds 109 | - delta_milliseconds 110 | - delta_microseconds 111 | - delta_nanoseconds 112 | - microsecond_of_day 113 | - nanosecond_of_day 114 | - with_microsecond_of_day 115 | - with_nanosecond_of_day 116 | 117 | 0.28 2015-09-12 118 | - Changed the lenient mode in ->from_string to be more lenient. The string 119 | representation may now consist of a mixture of the basic format and the 120 | extended format. e.g. the date may be in the basic format, while the 121 | time of day is in the extended format, 20121224T12:15:30Z. 122 | - Changed the fractional second precision in ->jd, ->mjd and ->rd from 123 | nanosecond to millisecond, higher precision can be returned by providing 124 | the optional named parameter precision. 125 | - Applied pull request by Gareth Harper (GHARPER) which fixes test issues, 126 | due to changes in Test::More (pull request #17). 127 | 128 | 0.27 2015-09-02 129 | - Added ->with method 130 | - Added Time::Moment::Adjusters 131 | - Added following examples to eg/ 132 | - eg/cal.pl 133 | - eg/excel.pl 134 | - eg/us_federal_holidays.pl 135 | 136 | 0.26 2015-08-28 137 | - The optional epoch date in ->from_jd and ->from_mjd has changed from 138 | 0001-01-01T00Z to 0000-12-31T00Z (Rata Die). 139 | - Applied patch from Vitaliy V. Tokarev (issue #15) which addresses builds 140 | on Solaris. 141 | - Added following methods to the API: 142 | - minutes_of_day 143 | - with_minutes_of_day 144 | - millisecond_of_day 145 | - with_millisecond_of_day 146 | - Internals has been refactored to ease maintainability 147 | - Added more test cases 148 | 149 | 0.25 2015-07-07 150 | - Added following methods to the API: 151 | - from_jd 152 | - from_mjd 153 | - rd 154 | 155 | 0.24 2015-05-20 156 | Bug fix for when Perl is compiled with threads. 157 | - Bug introduced in 60591ef (0.23) fixes issue #13, reported by 158 | Dmytro Zagashev (ZDM). 159 | 160 | 0.23 2015-05-19 161 | - Added following methods to the API: 162 | - at_midnight 163 | - at_noon 164 | - at_last_day_of_year 165 | - at_last_day_of_quarter 166 | - at_last_day_of_month 167 | - with_second_of_day 168 | 169 | 0.22 2015-02-14 170 | - Fixed issue #12. Redefinition of bool with Visual Studio 2013 C compiler, 171 | reported by A. Sinan Ünür (NANIS). 172 | - Added following method: 173 | - second_of_day 174 | 175 | 0.21 2014-11-23 176 | - Added following methods to increase consistency in the API: 177 | - with_week 178 | - with_day_of_week 179 | - length_of_week_year 180 | 181 | 0.20 2014-11-04 182 | - Reduced the required accuracy in ISO 8601 representations, previously 183 | the time of day where required to include hour and minute, the required 184 | accuracy has now been reduced to hour. 185 | - Documented the %w conversion specification in ->srtftime, reported 186 | by Peter Isaksson. 187 | - Minor documentation tweaks. 188 | 189 | 0.19 2014-10-08 190 | - Fixed Makefile.PL to only check if Module::Install is missing, should 191 | make it possible to install using cpanm. 192 | - Added accessors for Julian Date (->jd) and Modified Julian Date (->mjd). 193 | 194 | 0.18 2014-09-09 195 | - Ensure that the referenced object has a SvREFCNT of 1 before trying to 196 | reuse the invocant, fixes issue #7. Reported by Tomohiro Hosaka (bokutin). 197 | - Added accessor method ->utc_year, used by DateTime::TimeZone for dates 198 | far into the future, fixes issue #6. Reported by Karl Lohner (klohner). 199 | 200 | 0.17 2014-08-07 201 | - Ensure that the SvREFCNT is 1 before trying to reuse the invocant in 202 | chained method calls (leont++). 203 | - Require Test::Fatal v0.006 or higher, fixes issue #5. Reported by 204 | Doug Bell (preaction). 205 | - Removed the "early preview release" warning from the documentation. 206 | 207 | 0.16 2014-03-18 208 | - Fixed the Storable thaw method to account for negative offsets 209 | - Corrected documentation for length_of_{year,quarter,month} methods 210 | - Added following methods to increase consistency in the API: 211 | - with_day_of_quarter() 212 | - with_millisecond() 213 | - with_microsecond() 214 | - plus_milliseconds() 215 | - plus_microseconds() 216 | - minus_milliseconds() 217 | - minus_microseconds() 218 | 219 | 0.15 2014-02-23 220 | - Changed API in to_string() to use named parameters instead of boolean to 221 | make the API more consistent. 222 | - Added three new methods: 223 | - length_of_year() 224 | - length_of_quarter() 225 | - length_of_month() 226 | - Corrected typedef declaration in dt_config.h, should now hopefully 227 | compile correctly on Windows when using MSC. 228 | 229 | 0.14 2014-01-26 230 | - Changed now() to use the reentrant localtime_r() if provided by libc 231 | - Added support for the literal strings 'UTC' and 'GMT' as UTC designator 232 | in from_string() when lenient is true. 233 | - Sereal is now a supported serializer, documented and tested. Added an 234 | examample of usage, eg/sereal.pl 235 | 236 | 0.13 2014-01-04 237 | - Implemented ->with_offset_same_local() 238 | - Renamed the method ->with_offset to ->with_offset_same_instant, the old 239 | method name is aliased. 240 | - Added a new section to the documentation "TIME ZONES" which shows how to 241 | convert between time zones using DateTime::TimeZone. 242 | - Added more tests 243 | 244 | 0.12 2013-12-29 245 | - Implemented support for lenient parsing in ->from_string, should be capable 246 | of parsing most ISO 8601 profiles, including non conformant ISO 8601 247 | representations such as ISO 9075. 248 | - Implemented support for generic FREEZE / THAW serialization, upcomming Sereal 249 | will support these callbacks. 250 | - Implemented ->new 251 | - Refactored test suite and added more tests 252 | - Implemented support for GNU's '_', '-' and '0' flags in ->strftime() 253 | - Added eg/strftime.pl 254 | 255 | 0.11 2013-12-15 256 | - Added support for date/time arithmethics 257 | - Added support for altering the components of the date/time 258 | - Changed ->from_epoch to only accept seconds and nanosecond parameters 259 | - Added POD section with example format strings 260 | - Documentation improvements 261 | 262 | 0.10 2013-12-07 263 | - Added support for fractional seconds in the constructor ->from_epoch 264 | - Added serialization support for: 265 | - Storable 266 | - JSON 267 | - CBOR 268 | - Changed the method ->to_string to return the same string representation 269 | as stringification. 270 | - Optimized the usage of chained method calls from constructors. 271 | - Added eg/cbor.pl and eg/json.pl 272 | 273 | 0.09 2013-12-05 274 | - Added new constructor method, ->now_utc 275 | - Added two extended conversion specifications, %k and %l. Both common in 276 | GNU, BSD and perl implementations of strftime() 277 | - The extended %f conversion specification now accepts an optional maximum 278 | field width 279 | - Documented remaining methods and overloaded operators 280 | - Added the now_utc constructor to dev/bench.pl 281 | 282 | 0.08 2013-12-04 283 | - Changed resolution from microsecond to nanosecond 284 | - Implemented ->with_nanosecond() 285 | - Documentation improvements 286 | - Fixed strftime() to preserve the SvUTF8 flag if the given format 287 | string has the SvUTF8 flag set. 288 | - Overhauled strftime() conversion specifications to better confirm to 289 | IEEE Std 1003.1. Extended conversion specifications is now documented 290 | as such. 291 | 292 | 0.07 2013-12-02 293 | - Documented most of the API. 294 | - Implemented ->to_string(). 295 | - Changed stringification to only include fractional seconds in output 296 | if present. 297 | 298 | 0.06 2013-11-31 299 | - Added more docs. 300 | 301 | 0.05 2013-11-30 302 | - Renamed internal variable pow10 to prevent symbol clashes 303 | 304 | 0.04 2013-11-30 305 | - Added accessor for week of the year, ->week 306 | - Implemented support for parsing of any ISO 8601 date and time of day 307 | in both extended and basic format. For example: 308 | - 0001-01-01T00:00:00Z (Calender date, extended format) 309 | - 00010101T000000Z (Calender date, basic format) 310 | - 0001-W01-1T00:00:00Z (Week date, extended format) 311 | - 0001W011T000000Z (Week date, basic format) 312 | - 0001-001T00:00:00Z (Ordinal date, extended format) 313 | - 0001001T000000Z (Ordinal date, basic format) 314 | - Added localtime() and POSIX::strftime() to benchmark, invoking 315 | Time::Moment->now is ~ 70% faster than invoking localtime(). 316 | 317 | 0.03 2013-11-28 318 | - Renamed variable 'sun' to 'sunday' to prevent conflict on Solaris 319 | operating system which defines a macro named 'sun'. (leont++) 320 | 321 | 0.02 2013-11-25 322 | - Implemented ->from_string() in C 323 | - Implemented ->now() in C if the system supports gettimeofday(2) 324 | - Added dev/sizeof.pl 325 | - Added Time::Piece to dev/bench.pl 326 | 327 | 0.01 2013-11-24 328 | - Initial CPAN preview release. 329 | 330 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | # Avoid version control files. 2 | \bRCS\b 3 | \bCVS\b 4 | \bSCCS\b 5 | ,v$ 6 | \B\.svn\b 7 | \B\.git\b 8 | \B\.gitignore\b 9 | \b_darcs\b 10 | \B\.cvsignore$ 11 | 12 | # Avoid VMS specific MakeMaker generated files 13 | \bDescrip.MMS$ 14 | \bDESCRIP.MMS$ 15 | \bdescrip.mms$ 16 | 17 | # Avoid Makemaker generated and utility files. 18 | \bMANIFEST\.bak 19 | \bMakefile$ 20 | \bblib/ 21 | \bMakeMaker-\d 22 | \bpm_to_blib\.ts$ 23 | \bpm_to_blib$ 24 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 25 | 26 | # Avoid Module::Build generated and utility files. 27 | \bBuild$ 28 | \b_build/ 29 | \bBuild.bat$ 30 | \bBuild.COM$ 31 | \bBUILD.COM$ 32 | \bbuild.com$ 33 | 34 | # Avoid temp and backup files. 35 | ~$ 36 | \.old$ 37 | \#$ 38 | \b\.# 39 | \.bak$ 40 | \.tmp$ 41 | \.# 42 | \.rej$ 43 | 44 | # Avoid OS-specific files/dirs 45 | # Mac OSX metadata 46 | \B\.DS_Store 47 | # Mac OSX SMB mount metadata files 48 | \B\._ 49 | 50 | # Avoid Devel::Cover and Devel::CoverX::Covered files. 51 | \bcover_db\b 52 | \bcovered\b 53 | 54 | # Avoid MYMETA files 55 | ^MYMETA\. 56 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use lib '.'; 2 | use strict; 3 | use warnings; 4 | 5 | BEGIN { 6 | unshift @INC, 'inc'; 7 | 8 | my @required = ( 9 | 'inc::Module::Install' => '1.00', 10 | 'Module::Install::XSUtil' => '0.36', 11 | 'Module::Install::ReadmeFromPod' => '0', 12 | ); 13 | 14 | my @missing; 15 | while(my($module, $version) = splice(@required, 0, 2)) { 16 | eval qq{use $module $version (); 1} 17 | or push @missing, $module; 18 | } 19 | 20 | if(@missing) { 21 | print qq{# The following modules are not available.\n}; 22 | print qq{# `perl $0 | cpanm` will install them:\n}; 23 | s/\A inc:: //x for @missing; 24 | print $_, "\n" for @missing; 25 | exit 1; 26 | } 27 | } 28 | 29 | use inc::Module::Install; 30 | 31 | name 'Time-Moment'; 32 | perl_version '5.008001'; 33 | all_from 'lib/Time/Moment.pm'; 34 | repository 'https://github.com/chansen/p5-time-moment'; 35 | bugtracker 'https://github.com/chansen/p5-time-moment/issues'; 36 | readme_from 'lib/Time/Moment.pod'; 37 | 38 | requires 'Carp' => '0'; 39 | requires 'XSLoader' => '0'; 40 | requires 'Time::HiRes' => '0'; 41 | 42 | test_requires 'Test::More' => '0.88'; 43 | test_requires 'Test::Fatal' => '0.006'; 44 | test_requires 'Test::Requires' => '0'; 45 | test_requires 'Test::Number::Delta' => '1.06'; 46 | 47 | cc_warnings; 48 | cc_include_paths 'src'; 49 | cc_src_paths '.'; 50 | 51 | ppport; 52 | requires_external_cc; 53 | 54 | WriteAll; 55 | -------------------------------------------------------------------------------- /dev/bench.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Benchmark qw[]; 6 | use DateTime qw[]; 7 | use Time::Moment qw[]; 8 | use Time::Piece qw[]; 9 | use POSIX qw[]; 10 | use Params::Coerce qw[]; 11 | 12 | { 13 | print "Benchmarking constructor: ->new()\n"; 14 | my $zone = DateTime::TimeZone->new(name => 'UTC'); 15 | Benchmark::cmpthese( -10, { 16 | 'DateTime' => sub { 17 | my $dt = DateTime->new( 18 | year => 2012, 19 | month => 12, 20 | day => 24, 21 | hour => 15, 22 | minute => 30, 23 | second => 45, 24 | nanosecond => 123456789, 25 | time_zone => $zone, 26 | ); 27 | }, 28 | 'Time::Moment' => sub { 29 | my $tm = Time::Moment->new( 30 | year => 2012, 31 | month => 12, 32 | day => 24, 33 | hour => 15, 34 | minute => 30, 35 | second => 45, 36 | nanosecond => 123456789, 37 | offset => 0 38 | ); 39 | }, 40 | }); 41 | } 42 | 43 | { 44 | print "\nBenchmarking constructor: ->now()\n"; 45 | my $zone = DateTime::TimeZone->new(name => 'local'); 46 | Benchmark::cmpthese( -10, { 47 | 'DateTime' => sub { 48 | my $dt = DateTime->now(time_zone => $zone); 49 | }, 50 | 'Time::Moment' => sub { 51 | my $tm = Time::Moment->now; 52 | }, 53 | 'Time::Piece' => sub { 54 | my $tp = Time::Piece::localtime(); 55 | }, 56 | 'localtime()' => sub { 57 | my @tm = localtime(); 58 | }, 59 | }); 60 | } 61 | 62 | { 63 | print "\nBenchmarking constructor: ->now_utc()\n"; 64 | Benchmark::cmpthese( -10, { 65 | 'DateTime' => sub { 66 | my $dt = DateTime->now; 67 | }, 68 | 'Time::Moment' => sub { 69 | my $tm = Time::Moment->now_utc; 70 | }, 71 | 'Time::Piece' => sub { 72 | my $tp = Time::Piece::gmtime(); 73 | }, 74 | 'gmtime()' => sub { 75 | my @tm = gmtime(); 76 | }, 77 | }); 78 | } 79 | 80 | { 81 | print "\nBenchmarking constructor: ->from_epoch()\n"; 82 | Benchmark::cmpthese( -10, { 83 | 'DateTime' => sub { 84 | my $dt = DateTime->from_epoch(epoch => 0); 85 | }, 86 | 'Time::Moment' => sub { 87 | my $tm = Time::Moment->from_epoch(0); 88 | }, 89 | 'Time::Piece' => sub { 90 | my $tp = Time::Piece::gmtime(0); 91 | }, 92 | }); 93 | } 94 | 95 | { 96 | print "\nBenchmarking accessor: ->year()\n"; 97 | my $dt = DateTime->now; 98 | my $tm = Time::Moment->now; 99 | my $tp = Time::Piece::localtime(); 100 | Benchmark::cmpthese( -10, { 101 | 'DateTime' => sub { 102 | my $year = $dt->year; 103 | }, 104 | 'Time::Moment' => sub { 105 | my $year = $tm->year; 106 | }, 107 | 'Time::Piece' => sub { 108 | my $year = $tp->year; 109 | }, 110 | }); 111 | } 112 | 113 | { 114 | print "\nBenchmarking arithmetic: +10 hours -10 hours\n"; 115 | my $dt = DateTime->now; 116 | my $tm = Time::Moment->now_utc; 117 | my $tp = Time::Piece::gmtime(); 118 | Benchmark::cmpthese( -10, { 119 | 'DateTime' => sub { 120 | my $r = $dt->add(hours => 10)->subtract(hours => 10); 121 | }, 122 | 'Time::Moment' => sub { 123 | my $r = $tm->plus_hours(10)->minus_hours(10); 124 | }, 125 | 'Time::Piece' => sub { 126 | my $r = $tp->add(10*60*60)->add(-10*60*60); 127 | }, 128 | }); 129 | } 130 | 131 | { 132 | print "\nBenchmarking arithmetic: delta hours\n"; 133 | my $tm1 = Time::Moment->from_string('2015-05-10T12+12'); 134 | my $tm2 = Time::Moment->from_string('2015-05-11T12-12'); 135 | my $dt1 = Params::Coerce::coerce('DateTime', $tm1); 136 | my $dt2 = Params::Coerce::coerce('DateTime', $tm2); 137 | my $tp1 = Params::Coerce::coerce('Time::Piece', $tm1); 138 | my $tp2 = Params::Coerce::coerce('Time::Piece', $tm2); 139 | Benchmark::cmpthese( -10, { 140 | 'DateTime' => sub { 141 | my $r = $dt1->delta_ms($dt2)->hours; 142 | }, 143 | 'Time::Moment' => sub { 144 | my $r = $tm1->delta_hours($tm2); 145 | }, 146 | 'Time::Piece' => sub { 147 | my $r = int($tp2->subtract($tp1)->hours); 148 | }, 149 | }); 150 | } 151 | 152 | { 153 | print "\nBenchmarking arithmetic: delta days\n"; 154 | my $tm1 = Time::Moment->from_string('2015-05-10T12+12'); 155 | my $tm2 = Time::Moment->from_string('2015-05-11T12-12'); 156 | my $dt1 = Params::Coerce::coerce('DateTime', $tm1); 157 | my $dt2 = Params::Coerce::coerce('DateTime', $tm2); 158 | Benchmark::cmpthese( -10, { 159 | 'DateTime' => sub { 160 | my $r = $dt1->delta_days($dt2)->delta_days; 161 | }, 162 | 'Time::Moment' => sub { 163 | my $r = $tm1->delta_days($tm2); 164 | }, 165 | }); 166 | } 167 | 168 | { 169 | print "\nBenchmarking: at end of current month\n"; 170 | my $dt = DateTime->now; 171 | my $tm = Time::Moment->now_utc; 172 | Benchmark::cmpthese( -10, { 173 | 'DateTime' => sub { 174 | $dt = $dt->set_day(1) 175 | ->add(months => 1) 176 | ->subtract(days => 1); 177 | }, 178 | 'Time::Moment' => sub { 179 | $tm = $tm->with_day_of_month(1) 180 | ->plus_months(1) 181 | ->minus_days(1); 182 | }, 183 | }); 184 | } 185 | 186 | { 187 | print "\nBenchmarking strftime: ->strftime('%FT%T')\n"; 188 | my $dt = DateTime->now; 189 | my $tm = Time::Moment->now; 190 | my $tp = Time::Piece::localtime(); 191 | my @lt = localtime(); 192 | Benchmark::cmpthese( -10, { 193 | 'DateTime' => sub { 194 | my $string = $dt->strftime('%FT%T'); 195 | }, 196 | 'Time::Moment' => sub { 197 | my $string = $tm->strftime('%FT%T'); 198 | }, 199 | 'Time::Piece' => sub { 200 | my $string = $tp->strftime('%FT%T'); 201 | }, 202 | 'POSIX::strftime' => sub { 203 | my $string = POSIX::strftime('%FT%T', @lt); 204 | }, 205 | }); 206 | } 207 | 208 | { 209 | print "\nBenchmarking sort: 1000 instants\n"; 210 | 211 | my @epochs = map { 212 | int(rand(365.2425 * 50) * 86400 + rand(86400)) 213 | } (1..1000); 214 | 215 | my @dt = map { 216 | DateTime->from_epoch(epoch => $_) 217 | } @epochs; 218 | 219 | my @tm = map { 220 | Time::Moment->from_epoch($_) 221 | } @epochs; 222 | 223 | my @tp = map { 224 | scalar Time::Piece::gmtime($_); 225 | } @epochs; 226 | 227 | Benchmark::cmpthese( -10, { 228 | 'DateTime' => sub { 229 | my @sorted = sort { $a->compare($b) } @dt; 230 | }, 231 | 'Time::Moment' => sub { 232 | my @sorted = sort { $a->compare($b) } @tm; 233 | }, 234 | 'Time::Piece' => sub { 235 | my @sorted = sort { $a->compare($b) } @tp; 236 | }, 237 | }); 238 | } 239 | 240 | eval { 241 | require DateTime::Format::ISO8601; 242 | require DateTime::Format::RFC3339; 243 | 244 | my $string = '2013-12-24T12:34:56.123456+02:00'; 245 | 246 | print "\nBenchmarking parsing: '$string'\n"; 247 | my $rfc_p = DateTime::Format::RFC3339->new; 248 | my $iso_p = DateTime::Format::ISO8601->new; 249 | Benchmark::cmpthese( -10, { 250 | 'Time::Moment' => sub { 251 | my $tm = Time::Moment->from_string($string); 252 | }, 253 | 'DT::F::ISO8601' => sub { 254 | my $dt = $iso_p->parse_datetime($string); 255 | }, 256 | 'DT::F::RFC3339' => sub { 257 | my $dt = $rfc_p->parse_datetime($string); 258 | }, 259 | }); 260 | }; 261 | 262 | -------------------------------------------------------------------------------- /dev/sizeof.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use DateTime qw[]; 6 | use Time::Moment qw[]; 7 | use Time::Piece qw[]; 8 | 9 | use Devel::Size qw[total_size]; 10 | use Storable qw[nfreeze]; 11 | 12 | my $tm = Time::Moment->now; 13 | my $tp = Time::Piece::localtime(); 14 | my $dt = DateTime->now; 15 | my $lt = [localtime()]; 16 | 17 | print "Comparing instance size:\n"; 18 | printf "Time::Moment ............... : %4d B\n", total_size($tm); 19 | printf "Time::Piece ................ : %4d B\n", total_size($tp); 20 | printf "localtime() ................ : %4d B\n", total_size($lt) - total_size([]); 21 | printf "DateTime ................... : %4d B\n", total_size($dt); 22 | printf "DateTime w/o zone and locale : %4d B\n", total_size do { 23 | my $clone = $dt->clone; 24 | delete @{$clone}{qw(time_zone locale)}; $clone; 25 | }; 26 | 27 | print "\nComparing Storable::nfreeze() size:\n"; 28 | printf "Time::Moment ............... : %4d B\n", length nfreeze $tm; 29 | printf "DateTime ................... : %4d B\n", length nfreeze $dt; 30 | 31 | -------------------------------------------------------------------------------- /eg/age.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment; 6 | 7 | # Calculates age of a person in calendar years. 8 | # 9 | # Where a person has been born on February 29th in a leap year, the 10 | # anniversary in a non-leap year can be taken to be February 28th or 11 | # March 1st. Some countries have laws defining which date a person 12 | # born on February 29th comes of age in legal terms. In England and 13 | # Wales, for example, the legal age of a leapling is March 1st in 14 | # common years. The same applies in Hong Kong. In Taiwan and in 15 | # New Zealand, the legal age of a leapling is February 28th in 16 | # common years. 17 | # https://en.wikipedia.org/wiki/February_29#Births 18 | sub calculate_age { 19 | @_ == 2 or @_ == 3 or die q/Usage: calculate_age($birth, $event [, $march])/; 20 | my ($birth, $event, $march) = @_; 21 | 22 | my $years = $birth->delta_years($event); 23 | 24 | unless ($march) { 25 | # Increment if birth is 02-29 and event is 02-28 in a non-leap year 26 | ++$years if $birth->day_of_year == 31 + 29 && $birth->is_leap_year 27 | && $event->day_of_year == 31 + 28 && !$event->is_leap_year; 28 | } 29 | return $years; 30 | } 31 | 32 | my @tests = ( 33 | [ '2008-02-28T00Z', '2015-02-27T00Z', 0, 6 ], 34 | [ '2008-02-28T00Z', '2015-02-28T00Z', 0, 7 ], 35 | [ '2008-02-28T00Z', '2015-03-01T00Z', 0, 7 ], 36 | [ '2008-02-29T00Z', '2015-02-27T00Z', 0, 6 ], 37 | [ '2008-02-29T00Z', '2015-02-28T00Z', 0, 7 ], 38 | [ '2008-02-29T00Z', '2015-03-01T00Z', 0, 7 ], 39 | [ '2008-03-01T00Z', '2015-02-27T00Z', 0, 6 ], 40 | [ '2008-03-01T00Z', '2015-02-28T00Z', 0, 6 ], 41 | [ '2008-03-01T00Z', '2015-03-01T00Z', 0, 7 ], 42 | [ '2008-02-29T00Z', '2016-02-27T00Z', 0, 7 ], 43 | [ '2008-02-29T00Z', '2016-02-28T00Z', 0, 7 ], 44 | [ '2008-02-29T00Z', '2016-02-29T00Z', 0, 8 ], 45 | [ '2008-02-29T00Z', '2016-03-01T00Z', 0, 8 ], 46 | 47 | [ '2008-02-28T00Z', '2015-02-27T00Z', 1, 6 ], 48 | [ '2008-02-28T00Z', '2015-02-28T00Z', 1, 7 ], 49 | [ '2008-02-28T00Z', '2015-03-01T00Z', 1, 7 ], 50 | [ '2008-02-29T00Z', '2015-02-27T00Z', 1, 6 ], 51 | [ '2008-02-29T00Z', '2015-02-28T00Z', 1, 6 ], 52 | [ '2008-02-29T00Z', '2015-03-01T00Z', 1, 7 ], 53 | [ '2008-03-01T00Z', '2015-02-27T00Z', 1, 6 ], 54 | [ '2008-03-01T00Z', '2015-02-28T00Z', 1, 6 ], 55 | [ '2008-03-01T00Z', '2015-03-01T00Z', 1, 7 ], 56 | [ '2008-02-29T00Z', '2016-02-27T00Z', 1, 7 ], 57 | [ '2008-02-29T00Z', '2016-02-28T00Z', 1, 7 ], 58 | [ '2008-02-29T00Z', '2016-02-29T00Z', 1, 8 ], 59 | [ '2008-02-29T00Z', '2016-03-01T00Z', 1, 8 ], 60 | ); 61 | 62 | use Test::More 0.88; 63 | 64 | foreach my $test (@tests) { 65 | my ($birth, $event, $march, $age) = @$test; 66 | my $got = calculate_age(Time::Moment->from_string($birth), 67 | Time::Moment->from_string($event), 68 | $march); 69 | is($got, $age, "calculate_age($birth, $event, $march)"); 70 | } 71 | 72 | done_testing(); 73 | -------------------------------------------------------------------------------- /eg/ago.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | use v5.10; 5 | 6 | use Carp qw[]; 7 | use Time::Moment qw[]; 8 | 9 | sub YEAR () { 365 + 1/4 - 1/100 + 1/400 } 10 | sub MONTH () { YEAR / 12 } 11 | sub DAY () { 1 } 12 | sub HOUR () { DAY / 24 } 13 | sub MINUTE () { HOUR / 60 } 14 | sub SECOND () { MINUTE / 60 } 15 | 16 | sub ago { 17 | @_ == 1 || @_ == 2 or Carp::croak(q/Usage: ago(since [, event])/); 18 | my ($since, $event) = @_; 19 | 20 | $event //= Time::Moment->now; 21 | 22 | ($since->is_before($event)) 23 | or Carp::croak(q/Given moment is in the future/); 24 | 25 | my $d = $event->mjd - $since->mjd; 26 | 27 | if ($d < 0.75 * DAY) { 28 | if ($d < 0.75 * MINUTE) { 29 | return 'a few seconds ago'; 30 | } 31 | elsif ($d < 1.5 * MINUTE) { 32 | return 'a minute ago'; 33 | } 34 | elsif ($d < 0.75 * HOUR) { 35 | return sprintf '%d minutes ago', $d / MINUTE + 0.5; 36 | } 37 | elsif ($d < 1.5 * HOUR) { 38 | return 'an hour ago'; 39 | } 40 | else { 41 | return sprintf '%d hours ago', $d / HOUR + 0.5; 42 | } 43 | } 44 | else { 45 | if ($d < 1.5 * DAY) { 46 | return 'a day ago'; 47 | } 48 | elsif ($d < 0.75 * MONTH) { 49 | return sprintf '%d days ago', $d / DAY + 0.5; 50 | } 51 | elsif ($d < 1.5 * MONTH) { 52 | return 'a month ago'; 53 | } 54 | elsif ($d < 0.75 * YEAR) { 55 | return sprintf '%d months ago', $d / MONTH + 0.5; 56 | } 57 | elsif ($d < 1.5 * YEAR) { 58 | return 'a year ago'; 59 | } 60 | else { 61 | return sprintf '%d years ago', $d / YEAR + 0.5; 62 | } 63 | } 64 | } 65 | 66 | my @tests = ( 67 | [ 10 * SECOND, 'a few seconds ago' ], 68 | [ 75 * SECOND, 'a minute ago' ], 69 | [ 1 * MINUTE, 'a minute ago' ], 70 | [ 30 * MINUTE, '30 minutes ago' ], 71 | [ 1 * HOUR, 'an hour ago' ], 72 | [ 2 * HOUR, '2 hours ago' ], 73 | [ 1 * DAY, 'a day ago' ], 74 | [ 20 * DAY, '20 days ago' ], 75 | [ 1 * MONTH, 'a month ago' ], 76 | [ 2 * MONTH, '2 months ago' ], 77 | [ 13 * MONTH, 'a year ago' ], 78 | [ 1 * YEAR, 'a year ago' ], 79 | [ 2 * YEAR, '2 years ago' ], 80 | [ 10 * YEAR, '10 years ago' ], 81 | [ 100 * YEAR, '100 years ago' ], 82 | ); 83 | 84 | use Time::Moment 0.25; 85 | use Test::More 0.88; 86 | 87 | my $now = Time::Moment->now; 88 | foreach my $test (@tests) { 89 | my ($duration, $expected) = @$test; 90 | my $tm = Time::Moment->from_mjd($now->mjd - $duration); 91 | is(ago($tm, $now), $expected, "$tm ($duration)"); 92 | } 93 | 94 | done_testing(); 95 | -------------------------------------------------------------------------------- /eg/beat.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment; 6 | 7 | # Converts the given moment to Swatch Internet Time (beat time). 8 | # http://www.swatch.com/en/internet-time 9 | # https://en.wikipedia.org/wiki/Swatch_Internet_Time 10 | sub moment_to_beat { 11 | @_ == 1 or die q/Usage: moment_to_beat(moment)/; 12 | my ($tm) = @_; 13 | 14 | # Biel Meantime (BMT) is UTC+1 15 | my $rd = $tm->with_offset_same_instant(1*60) 16 | ->rd; 17 | return ($rd - int $rd) * 1E3; 18 | } 19 | 20 | my $tm = Time::Moment->now; 21 | printf "@%3.3f\n", moment_to_beat($tm); 22 | -------------------------------------------------------------------------------- /eg/cal.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | use v5.10; 5 | 6 | use Getopt::Long qw[]; 7 | use Time::Moment qw[]; 8 | 9 | my $FirstDayOfWeek = 1; # Monday 10 | my $Moment = Time::Moment->now 11 | ->with_day_of_month(1) 12 | ->at_midnight; 13 | 14 | Getopt::Long::GetOptions( 15 | 'y|year=i' => sub { 16 | my ($name, $year) = @_; 17 | 18 | ($year >= 1 && $year <= 9999) 19 | or die qq/Option '$name' is out of the range [1, 9999]\n/; 20 | 21 | $Moment = $Moment->with_year($year); 22 | }, 23 | 'm|month=i' => sub { 24 | my ($name, $month) = @_; 25 | 26 | ($month >= 1 && $month <= 12) 27 | or die qq/Option '$name' is out of the range [1=January, 12=December]\n/; 28 | 29 | $Moment = $Moment->with_month($month); 30 | }, 31 | 'f|first=i' => sub { 32 | my ($name, $day) = @_; 33 | 34 | ($day >= 1 && $day <= 7) 35 | or die qq/Option '$name' is out of the range [1=Monday, 7=Sunday]\n/; 36 | 37 | $FirstDayOfWeek = $day; 38 | }, 39 | ) or do { 40 | say "usage: $0 [-y year] [-m month] [-f day]"; 41 | say " -y --year the year [1, 9999]"; 42 | say " -m --month the month of the year [1=January, 12=December]"; 43 | say " -f --first the first day of the week [1=Monday, 7=Sunday]"; 44 | exit(1); 45 | }; 46 | 47 | sub align { 48 | @_ == 2 or die q/Usage: align(string, width)/; 49 | my ($string, $width) = @_; 50 | return sprintf "%*s", ($width + length $string) / 2, $string; 51 | } 52 | 53 | say align($Moment->strftime('%B %Y'), 20); 54 | say join ' ', map { 55 | (qw[ Mo Tu We Th Fr Sa Su ])[ ($_ + $FirstDayOfWeek - 1) % 7 ] 56 | } (0..6); 57 | 58 | my $this_month = $Moment; 59 | my $next_month = $Moment->plus_months(1); 60 | my $date = $Moment->minus_weeks($FirstDayOfWeek > $Moment->day_of_week) 61 | ->with_day_of_week($FirstDayOfWeek); 62 | 63 | while ($date->is_before($next_month)) { 64 | my @week; 65 | foreach my $day (1..7) { 66 | if ($date->is_before($this_month)) { 67 | push @week, ' '; 68 | } 69 | elsif ($date->is_before($next_month)) { 70 | push @week, sprintf '%2d', $date->day_of_month; 71 | } 72 | $date = $date->plus_days(1); 73 | } 74 | say join ' ', @week; 75 | } 76 | -------------------------------------------------------------------------------- /eg/cbor.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment qw[]; 6 | use Time::HiRes qw[]; 7 | use CBOR::XS qw[encode_cbor]; 8 | 9 | sub filter { 10 | my ($tag) = @_; 11 | # http://www.iana.org/assignments/cbor-tags/cbor-tags.xhtml 12 | if ($tag == 0) { return Time::Moment->from_string($_[1]) } 13 | elsif ($tag == 1) { return Time::Moment->from_epoch($_[1]) } 14 | else { return &CBOR::XS::default_filter } 15 | } 16 | 17 | my $encoded = encode_cbor([ 18 | # Tag 0 is standard date/time string; see Section 2.4.1 19 | CBOR::XS::tag(0, '2013-12-24T12:30:45.123456789+01:00'), 20 | # Tag 1 is epoch-based date/time; see Section 2.4.1 21 | CBOR::XS::tag(1, time), 22 | CBOR::XS::tag(1, Time::HiRes::time), 23 | # Serializes as tag 0 24 | Time::Moment->now, 25 | ]); 26 | 27 | my $decoded = CBOR::XS->new->filter(\&filter)->decode($encoded); 28 | foreach my $moment (@$decoded) { 29 | print $moment->to_string, "\n"; 30 | } 31 | -------------------------------------------------------------------------------- /eg/clocks.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment; 6 | use DateTime::TimeZone; 7 | 8 | my @zones = qw( 9 | Africa/Cairo 10 | America/Chicago 11 | America/Los_Angeles 12 | America/New_York 13 | Asia/Dubai 14 | Asia/Hong_Kong 15 | Asia/Kathmandu 16 | Asia/Tokyo 17 | Australia/Sydney 18 | Europe/Brussels 19 | Europe/London 20 | Europe/Moscow 21 | Europe/Paris 22 | Europe/Stockholm 23 | Pacific/Apia 24 | ); 25 | 26 | my $now = Time::Moment->now; 27 | my @clocks; 28 | foreach my $name (@zones) { 29 | my $zone = DateTime::TimeZone->new(name => $name); 30 | my $offset = $zone->offset_for_datetime($now) / 60; 31 | my $time = $now->with_offset_same_instant($offset); 32 | $name =~ s![^/]+/!!; 33 | $name =~ s!_!\x20!g; 34 | push @clocks, [$name, $time]; 35 | } 36 | 37 | @clocks = sort { 38 | $a->[1]->offset <=> $b->[1]->offset 39 | or $a->[0] cmp $b->[0] 40 | } @clocks; 41 | 42 | for my $clock (@clocks) { 43 | my ($name, $time) = @$clock; 44 | my $delta = $time->offset - $now->offset; 45 | printf "%-12s %-16s (%+.2d:%.2d)\n", 46 | $name, $time->strftime("%a %H:%M %:z"), $delta / 60, abs($delta) % 60; 47 | } 48 | -------------------------------------------------------------------------------- /eg/excel.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | # Convert between Excel serial dates and Time::Moment 6 | use Time::Moment; 7 | 8 | use constant EXCEL_EPOCH => Time::Moment->from_string('1899-12-30T00Z')->rd; 9 | 10 | sub moment_from_excel { 11 | @_ == 1 or die q/Usage: moment_from_excel(date)/; 12 | my ($date) = @_; 13 | return Time::Moment->from_rd($date + ($date < 61), epoch => EXCEL_EPOCH); 14 | } 15 | 16 | sub moment_to_excel { 17 | @_ == 1 or die q/Usage: moment_to_excel(moment)/; 18 | my ($moment) = @_; 19 | my $date = $moment->rd - EXCEL_EPOCH; 20 | return $date - ($date < 61); 21 | } 22 | 23 | my @tests = ( 24 | [ '1899-12-31T00:00:00Z', 0 ], 25 | [ '1900-01-01T00:00:00Z', 1 ], 26 | [ '1900-02-27T00:00:00Z', 58 ], 27 | [ '1900-02-28T00:00:00Z', 59 ], 28 | [ '1900-03-01T00:00:00Z', 61 ], 29 | [ '1900-03-02T00:00:00Z', 62 ], 30 | [ '1969-12-31T23:59:58Z', 25568.9999768519 ], 31 | [ '1969-12-31T23:59:58.500Z', 25568.9999826389 ], 32 | [ '1969-12-31T23:59:58.800Z', 25568.9999861111 ], 33 | [ '1969-12-31T23:59:58.900Z', 25568.9999872685 ], 34 | [ '1969-12-31T23:59:58.980Z', 25568.9999881944 ], 35 | [ '1969-12-31T23:59:58.990Z', 25568.9999883102 ], 36 | [ '1969-12-31T23:59:58.998Z', 25568.9999884028 ], 37 | [ '1969-12-31T23:59:58.999Z', 25568.9999884143 ], 38 | [ '1969-12-31T23:59:59Z', 25568.9999884259 ], 39 | [ '1969-12-31T23:59:59.001Z', 25568.9999884375 ], 40 | [ '1969-12-31T23:59:59.002Z', 25568.9999884490 ], 41 | [ '1969-12-31T23:59:59.010Z', 25568.9999885417 ], 42 | [ '1969-12-31T23:59:59.020Z', 25568.9999886574 ], 43 | [ '1969-12-31T23:59:59.100Z', 25568.9999895834 ], 44 | [ '1969-12-31T23:59:59.200Z', 25568.9999907408 ], 45 | [ '1969-12-31T23:59:59.300Z', 25568.9999918982 ], 46 | [ '1969-12-31T23:59:59.400Z', 25568.9999930556 ], 47 | [ '1969-12-31T23:59:59.490Z', 25568.9999940973 ], 48 | [ '1969-12-31T23:59:59.499Z', 25568.9999942014 ], 49 | [ '1969-12-31T23:59:59.500Z', 25568.9999942130 ], 50 | [ '1969-12-31T23:59:59.501Z', 25568.9999942245 ], 51 | [ '1969-12-31T23:59:59.510Z', 25568.9999943287 ], 52 | [ '1969-12-31T23:59:59.600Z', 25568.9999953704 ], 53 | [ '1969-12-31T23:59:59.700Z', 25568.9999965278 ], 54 | [ '1969-12-31T23:59:59.800Z', 25568.9999976852 ], 55 | [ '1969-12-31T23:59:59.900Z', 25568.9999988426 ], 56 | [ '1969-12-31T23:59:59.980Z', 25568.9999997686 ], 57 | [ '1969-12-31T23:59:59.990Z', 25568.9999998843 ], 58 | [ '1969-12-31T23:59:59.998Z', 25568.9999999768 ], 59 | [ '1969-12-31T23:59:59.999Z', 25568.9999999885 ], 60 | [ '1970-01-01T00:00:00Z', 25569 ], 61 | [ '1970-01-01T00:00:00.001Z', 25569.0000000115 ], 62 | [ '1970-01-01T00:00:00.002Z', 25569.0000000232 ], 63 | [ '1970-01-01T00:00:00.010Z', 25569.0000001157 ], 64 | [ '1970-01-01T00:00:00.020Z', 25569.0000002314 ], 65 | [ '1970-01-01T00:00:00.100Z', 25569.0000011574 ], 66 | [ '1970-01-01T00:00:00.200Z', 25569.0000023148 ], 67 | [ '1970-01-01T00:00:00.300Z', 25569.0000034722 ], 68 | [ '1970-01-01T00:00:00.400Z', 25569.0000046296 ], 69 | [ '1970-01-01T00:00:00.490Z', 25569.0000056713 ], 70 | [ '1970-01-01T00:00:00.499Z', 25569.0000057755 ], 71 | [ '1970-01-01T00:00:00.500Z', 25569.0000057870 ], 72 | [ '1970-01-01T00:00:00.501Z', 25569.0000057986 ], 73 | [ '1970-01-01T00:00:00.510Z', 25569.0000059027 ], 74 | [ '1970-01-01T00:00:00.600Z', 25569.0000069444 ], 75 | [ '1970-01-01T00:00:00.700Z', 25569.0000081018 ], 76 | [ '1970-01-01T00:00:00.800Z', 25569.0000092592 ], 77 | [ '1970-01-01T00:00:00.900Z', 25569.0000104166 ], 78 | [ '1970-01-01T00:00:00.980Z', 25569.0000113426 ], 79 | [ '1970-01-01T00:00:00.990Z', 25569.0000114583 ], 80 | [ '1970-01-01T00:00:00.998Z', 25569.0000115510 ], 81 | [ '1970-01-01T00:00:00.999Z', 25569.0000115625 ], 82 | [ '1970-01-01T00:00:01Z', 25569.0000115741 ], 83 | [ '1970-01-01T00:00:01.001Z', 25569.0000115857 ], 84 | [ '1970-01-01T00:00:01.002Z', 25569.0000115972 ], 85 | [ '1970-01-01T00:00:01.010Z', 25569.0000116898 ], 86 | [ '1970-01-01T00:00:01.020Z', 25569.0000118056 ], 87 | [ '1970-01-01T00:00:01.100Z', 25569.0000127315 ], 88 | [ '1970-01-01T00:00:01.200Z', 25569.0000138889 ], 89 | [ '9999-12-31T23:59:58Z', 2958465.9999768520 ], 90 | [ '9999-12-31T23:59:58.500Z', 2958465.9999826388 ], 91 | [ '9999-12-31T23:59:58.800Z', 2958465.9999861112 ], 92 | [ '9999-12-31T23:59:58.900Z', 2958465.9999872684 ], 93 | [ '9999-12-31T23:59:58.980Z', 2958465.9999881946 ], 94 | [ '9999-12-31T23:59:58.990Z', 2958465.9999883100 ], 95 | [ '9999-12-31T23:59:58.998Z', 2958465.9999884027 ], 96 | [ '9999-12-31T23:59:58.999Z', 2958465.9999884143 ], 97 | [ '9999-12-31T23:59:59Z', 2958465.9999884260 ], 98 | [ '9999-12-31T23:59:59.001Z', 2958465.9999884376 ], 99 | [ '9999-12-31T23:59:59.002Z', 2958465.9999884493 ], 100 | [ '9999-12-31T23:59:59.010Z', 2958465.9999885415 ], 101 | [ '9999-12-31T23:59:59.020Z', 2958465.9999886574 ], 102 | [ '9999-12-31T23:59:59.100Z', 2958465.9999895832 ], 103 | [ '9999-12-31T23:59:59.200Z', 2958465.9999907408 ], 104 | [ '9999-12-31T23:59:59.300Z', 2958465.9999918980 ], 105 | [ '9999-12-31T23:59:59.400Z', 2958465.9999930556 ], 106 | [ '9999-12-31T23:59:59.490Z', 2958465.9999940973 ], 107 | [ '9999-12-31T23:59:59.499Z', 2958465.9999942016 ], 108 | [ '9999-12-31T23:59:59.500Z', 2958465.9999942128 ], 109 | [ '9999-12-31T23:59:59.501Z', 2958465.9999942244 ], 110 | [ '9999-12-31T23:59:59.510Z', 2958465.9999943287 ], 111 | [ '9999-12-31T23:59:59.600Z', 2958465.9999953704 ], 112 | [ '9999-12-31T23:59:59.700Z', 2958465.9999965276 ], 113 | [ '9999-12-31T23:59:59.800Z', 2958465.9999976852 ], 114 | [ '9999-12-31T23:59:59.900Z', 2958465.9999988424 ], 115 | [ '9999-12-31T23:59:59.980Z', 2958465.9999997686 ], 116 | [ '9999-12-31T23:59:59.990Z', 2958465.9999998841 ], 117 | [ '9999-12-31T23:59:59.998Z', 2958465.9999999767 ], 118 | [ '9999-12-31T23:59:59.999Z', 2958465.9999999884 ], 119 | ); 120 | 121 | use Test::More 0.88; 122 | use Test::Number::Delta 1.06 relative => 1E-10; 123 | 124 | foreach my $test (@tests) { 125 | my ($string, $date) = @$test; 126 | my $tm = moment_from_excel($date); 127 | is($tm->to_string, $string, "moment_from_excel($date)"); 128 | delta_ok(moment_to_excel($tm), $date, "moment_to_excel($tm)"); 129 | } 130 | 131 | done_testing(); 132 | 133 | eval { 134 | require DateTime::Format::Excel; 135 | require Benchmark; 136 | { 137 | print "\nComparing DateTime::Format::Excel and Time::Moment\n"; 138 | my $date = 30188.010650613425; 139 | Benchmark::cmpthese( -10, { 140 | 'DateTime' => sub { 141 | my $dt = DateTime::Format::Excel->parse_datetime($date); 142 | }, 143 | 'Time::Moment' => sub { 144 | my $tm = moment_from_excel($date); 145 | }, 146 | }); 147 | } 148 | }; 149 | -------------------------------------------------------------------------------- /eg/json.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment qw[]; 6 | use JSON::XS qw[]; 7 | 8 | print JSON::XS->new->convert_blessed->encode([ Time::Moment->now ]), "\n"; 9 | -------------------------------------------------------------------------------- /eg/se_bank_holidays.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment; 6 | use Time::Moment::Adjusters qw[ NextOrSameDayOfWeek 7 | WesternEasterSunday ]; 8 | 9 | use enum qw[ Monday=1 Tuesday Wednesday Thursday Friday Saturday Sunday ]; 10 | 11 | # Lag (1989:253) om allmänna helgdagar (Act (1989:253) on public holidays) 12 | # https://lagen.nu/1989:253 13 | sub compute_public_holidays { 14 | @_ == 1 or die q; 15 | my ($year) = @_; 16 | 17 | my @dates; 18 | my $tm = Time::Moment->new(year => $year); 19 | my $easter = $tm->with(WesternEasterSunday); 20 | 21 | # Nyårsdagen (New Year's Day), January 1. 22 | push @dates, $tm->with_month(1) 23 | ->with_day_of_month(1); 24 | 25 | # Trettondagen (Epiphany), January 6. 26 | push @dates, $tm->with_month(1) 27 | ->with_day_of_month(6); 28 | 29 | # Långfredagen (Good Friday), the Friday preceding Easter Sunday. 30 | push @dates, $easter->minus_days(2); 31 | 32 | # Påskdagen (Easter Sunday), the Sunday immediately following 33 | # the full moon that occurs on or next after 21 March. 34 | push @dates, $easter; 35 | 36 | # Annandag påsk (Easter Monday), the day after Easter Sunday. 37 | push @dates, $easter->plus_days(1); 38 | 39 | # Kristi himmelsfärds dag (Ascension Day), sixth Thursday 40 | # after Easter Sunday. 41 | push @dates, $easter->plus_days(5*7+4); 42 | 43 | # Pingstdagen (Pentecost), seventh Sunday after Easter Sunday. 44 | push @dates, $easter->plus_days(7*7); 45 | 46 | # Annandag pingst (Whit Monday), the day after Pentecost. 47 | if ($year <= 2004) { 48 | push @dates, $easter->plus_days(7*7+1); 49 | } 50 | 51 | # Första maj (First of May), May 1. 52 | push @dates, $tm->with_month(5) 53 | ->with_day_of_month(1); 54 | 55 | # Sveriges nationaldag (National Day of Sweden), June 6. 56 | if ($year >= 2005) { 57 | push @dates, $tm->with_month(6) 58 | ->with_day_of_month(6); 59 | } 60 | 61 | # Midsommardagen (Midsummer's Day), Saturday that falls 62 | # between June 20th to 26th. 63 | push @dates, $tm->with_month(6) 64 | ->with_day_of_month(20) 65 | ->with(NextOrSameDayOfWeek(Saturday)); 66 | 67 | # Alla helgons dag (All Saints' Day), Saturday that falls 68 | # between Oct 31st to Nov 6th. 69 | push @dates, $tm->with_month(10) 70 | ->with_day_of_month(31) 71 | ->with(NextOrSameDayOfWeek(Saturday)); 72 | 73 | # Juldagen (Christmas Day), December 25. 74 | push @dates, $tm->with_month(12) 75 | ->with_day_of_month(25); 76 | 77 | # Annandag jul (Boxing Day), December 26. 78 | push @dates, $tm->with_month(12) 79 | ->with_day_of_month(26); 80 | 81 | return @dates; 82 | } 83 | 84 | # Swedish bank holidays 85 | # All days except Saturdays, Sundays, Epiphany, Good Friday, 86 | # Easter Monday, First of May, Ascension Day, Sweden's National 87 | # Day, Midsummer Eve, Christmas Eve, Christmas Day, Boxing 88 | # Day, New Year's Eve and New Year's Day (all according to the 89 | # Swedish calendar), as well as any other days currently stipulated 90 | # by the Swedish Act (1989:253) on Public Holidays. 91 | sub compute_bank_holidays { 92 | @_ == 1 or die q; 93 | my ($year) = @_; 94 | 95 | my @dates = compute_public_holidays($year); 96 | my $tm = Time::Moment->new(year => $year); 97 | 98 | # Midsommarafton (Midsummer's Eve), Friday that falls 99 | # between June 19th to 25th. 100 | push @dates, $tm->with_month(6) 101 | ->with_day_of_month(19) 102 | ->with(NextOrSameDayOfWeek(Friday)); 103 | 104 | # Julafton (Christmas Eve), December 24. 105 | push @dates, $tm->with_month(12) 106 | ->with_day_of_month(24); 107 | 108 | # Nyårsafton (New Year's Eve), December 31. 109 | push @dates, $tm->with_month(12) 110 | ->with_day_of_month(31); 111 | 112 | return sort { $a <=> $b } 113 | grep { $_->day_of_week <= Friday } @dates; 114 | } 115 | 116 | my @tests = ( 117 | [ 2000, '2000-01-06', '2000-04-21', '2000-04-24', '2000-05-01', '2000-06-01', 118 | '2000-06-12', '2000-06-23', '2000-12-25', '2000-12-26' ], 119 | [ 2001, '2001-01-01', '2001-04-13', '2001-04-16', '2001-05-01', '2001-05-24', 120 | '2001-06-04', '2001-06-22', '2001-12-24', '2001-12-25', '2001-12-26', 121 | '2001-12-31' ], 122 | [ 2002, '2002-01-01', '2002-03-29', '2002-04-01', '2002-05-01', '2002-05-09', 123 | '2002-05-20', '2002-06-21', '2002-12-24', '2002-12-25', '2002-12-26', 124 | '2002-12-31' ], 125 | [ 2003, '2003-01-01', '2003-01-06', '2003-04-18', '2003-04-21', '2003-05-01', 126 | '2003-05-29', '2003-06-09', '2003-06-20', '2003-12-24', '2003-12-25', 127 | '2003-12-26', '2003-12-31' ], 128 | [ 2004, '2004-01-01', '2004-01-06', '2004-04-09', '2004-04-12', '2004-05-20', 129 | '2004-05-31', '2004-06-25', '2004-12-24', '2004-12-31' ], 130 | [ 2005, '2005-01-06', '2005-03-25', '2005-03-28', '2005-05-05', '2005-06-06', 131 | '2005-06-24', '2005-12-26' ], 132 | [ 2006, '2006-01-06', '2006-04-14', '2006-04-17', '2006-05-01', '2006-05-25', 133 | '2006-06-06', '2006-06-23', '2006-12-25', '2006-12-26' ], 134 | [ 2007, '2007-01-01', '2007-04-06', '2007-04-09', '2007-05-01', '2007-05-17', 135 | '2007-06-06', '2007-06-22', '2007-12-24', '2007-12-25', '2007-12-26', 136 | '2007-12-31' ], 137 | [ 2008, '2008-01-01', '2008-03-21', '2008-03-24', '2008-05-01', '2008-05-01', 138 | '2008-06-06', '2008-06-20', '2008-12-24', '2008-12-25', '2008-12-26', 139 | '2008-12-31' ], 140 | [ 2009, '2009-01-01', '2009-01-06', '2009-04-10', '2009-04-13', '2009-05-01', 141 | '2009-05-21', '2009-06-19', '2009-12-24', '2009-12-25', '2009-12-31' ], 142 | [ 2010, '2010-01-01', '2010-01-06', '2010-04-02', '2010-04-05', '2010-05-13', 143 | '2010-06-25', '2010-12-24', '2010-12-31' ], 144 | [ 2011, '2011-01-06', '2011-04-22', '2011-04-25', '2011-06-02', '2011-06-06', 145 | '2011-06-24', '2011-12-26' ], 146 | [ 2012, '2012-01-06', '2012-04-06', '2012-04-09', '2012-05-01', '2012-05-17', 147 | '2012-06-06', '2012-06-22', '2012-12-24', '2012-12-25', '2012-12-26', 148 | '2012-12-31' ], 149 | [ 2013, '2013-01-01', '2013-03-29', '2013-04-01', '2013-05-01', '2013-05-09', 150 | '2013-06-06', '2013-06-21', '2013-12-24', '2013-12-25', '2013-12-26', 151 | '2013-12-31' ], 152 | [ 2014, '2014-01-01', '2014-01-06', '2014-04-18', '2014-04-21', '2014-05-01', 153 | '2014-05-29', '2014-06-06', '2014-06-20', '2014-12-24', '2014-12-25', 154 | '2014-12-26', '2014-12-31' ], 155 | [ 2015, '2015-01-01', '2015-01-06', '2015-04-03', '2015-04-06', '2015-05-01', 156 | '2015-05-14', '2015-06-19', '2015-12-24', '2015-12-25', '2015-12-31' ], 157 | [ 2016, '2016-01-01', '2016-01-06', '2016-03-25', '2016-03-28', '2016-05-05', 158 | '2016-06-06', '2016-06-24', '2016-12-26' ], 159 | [ 2017, '2017-01-06', '2017-04-14', '2017-04-17', '2017-05-01', '2017-05-25', 160 | '2017-06-06', '2017-06-23', '2017-12-25', '2017-12-26' ], 161 | [ 2018, '2018-01-01', '2018-03-30', '2018-04-02', '2018-05-01', '2018-05-10', 162 | '2018-06-06', '2018-06-22', '2018-12-24', '2018-12-25', '2018-12-26', 163 | '2018-12-31' ], 164 | [ 2019, '2019-01-01', '2019-04-19', '2019-04-22', '2019-05-01', '2019-05-30', 165 | '2019-06-06', '2019-06-21', '2019-12-24', '2019-12-25', '2019-12-26', 166 | '2019-12-31' ], 167 | [ 2020, '2020-01-01', '2020-01-06', '2020-04-10', '2020-04-13', '2020-05-01', 168 | '2020-05-21', '2020-06-19', '2020-12-24', '2020-12-25', '2020-12-31' ], 169 | ); 170 | 171 | use Test::More 0.88; 172 | 173 | foreach my $test (@tests) { 174 | my ($year, @exp) = @$test; 175 | my @got = map { 176 | $_->strftime('%Y-%m-%d') 177 | } compute_bank_holidays($year); 178 | is_deeply([@got], [@exp], "Swedish bank holidays for year $year"); 179 | } 180 | 181 | done_testing(); 182 | 183 | -------------------------------------------------------------------------------- /eg/sereal.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment qw[]; 6 | use Sereal 2.030 qw[encode_sereal decode_sereal]; 7 | 8 | my @moments = (Time::Moment->now, Time::Moment->now_utc); 9 | my $encoded = encode_sereal([ @moments ], { freeze_callbacks => 1 }); 10 | my $decoded = decode_sereal($encoded); 11 | 12 | foreach my $moment (@$decoded) { 13 | print $moment->to_string, "\n"; 14 | } 15 | -------------------------------------------------------------------------------- /eg/strftime.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment; 6 | 7 | my $tm = Time::Moment->now; 8 | 9 | sub output { 10 | my ($type, $basic, $extended) = @_; 11 | 12 | print "\nCombinations of $type date and time of day:\n"; 13 | 14 | print "\nBasic format: Example:\n"; 15 | foreach my $format (@$basic) { 16 | printf "%-22s %s\n", $format, $tm->strftime($format); 17 | } 18 | 19 | print "\nExtended format: Example:\n"; 20 | foreach my $format (@$extended) { 21 | printf "%-22s %s\n", $format, $tm->strftime($format); 22 | } 23 | } 24 | 25 | { 26 | my @basic = qw( 27 | %Y%m%dT%H%M%S%z 28 | %Y%m%dT%H%M%S%f%z 29 | %Y%m%dT%H%M%z 30 | ); 31 | my @extended = qw( 32 | %Y-%m-%dT%H:%M:%S%Z 33 | %Y-%m-%dT%H:%M:%S%f%Z 34 | %Y-%m-%dT%H:%M%Z 35 | ); 36 | output('calendar', \@basic, \@extended); 37 | } 38 | 39 | { 40 | my @basic = qw( 41 | %Y%jT%H%M%S%z 42 | %Y%jT%H%M%S%f%z 43 | %Y%jT%H%M%z 44 | ); 45 | my @extended = qw( 46 | %Y-%jT%H:%M:%S%Z 47 | %Y-%jT%H:%M:%S%f%Z 48 | %Y-%jT%H:%M%Z 49 | ); 50 | output('ordinal', \@basic, \@extended); 51 | } 52 | 53 | { 54 | my @basic = qw( 55 | %GW%V%uT%H%M%S%z 56 | %GW%V%uT%H%M%S%f%z 57 | %GW%V%uT%H%M%z 58 | ); 59 | my @extended = qw( 60 | %G-W%V-%uT%H:%M:%S%Z 61 | %G-W%V-%uT%H:%M:%S%f%Z 62 | %G-W%V-%uT%H:%M%Z 63 | ); 64 | output('week', \@basic, \@extended); 65 | } 66 | -------------------------------------------------------------------------------- /eg/us_federal_holidays.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | 5 | use Time::Moment; 6 | use Time::Moment::Adjusters qw[ NthDayOfWeekInMonth ]; 7 | 8 | use enum qw[ Monday=1 Tuesday Wednesday Thursday Friday Saturday Sunday ]; 9 | use enum qw[ First=1 Second Third Fourth Last=-1 ]; 10 | 11 | use constant FirstMondayInMonth => NthDayOfWeekInMonth(First, Monday); 12 | use constant SecondMondayInMonth => NthDayOfWeekInMonth(Second, Monday); 13 | use constant ThirdMondayInMonth => NthDayOfWeekInMonth(Third, Monday); 14 | use constant LastMondayInMonth => NthDayOfWeekInMonth(Last, Monday); 15 | use constant FourthThursdayInMonth => NthDayOfWeekInMonth(Fourth, Thursday); 16 | 17 | # Adjusts the date to the nearest workday 18 | use constant NearestWorkday => sub { 19 | my ($tm) = @_; 20 | return $tm unless $tm->day_of_week > Friday; 21 | return $tm->plus_days($tm->day_of_week == Saturday ? -1 : +1); 22 | }; 23 | 24 | # Federal law 5 USC § 6103 - HOLIDAYS 25 | # http://www.law.cornell.edu/uscode/text/5/6103 26 | sub compute_us_federal_holidays { 27 | @_ == 1 or @_ == 2 or die q; 28 | my ($year, $inauguration) = @_; 29 | 30 | my @dates; 31 | my $tm = Time::Moment->new(year => $year); 32 | 33 | # New Year’s Day, January 1. 34 | push @dates, $tm->with_month(1) 35 | ->with_day_of_month(1) 36 | ->with(NearestWorkday); 37 | 38 | # Birthday of Martin Luther King, Jr., the third Monday in January. 39 | push @dates, $tm->with_month(1) 40 | ->with(ThirdMondayInMonth); 41 | 42 | # Inauguration Day, January 20 of each fourth year after 1965. 43 | if ($inauguration && $year % 4 == 1) { 44 | my $date = $tm->with_month(1) 45 | ->with_day_of_month(20); 46 | 47 | # When January 20 falls on Sunday, the next succeeding day is selected. 48 | $date = $date->plus_days(1) 49 | if $date->day_of_week == Sunday; 50 | 51 | push @dates, $date 52 | unless $date->day_of_week == Saturday 53 | or $date->is_equal($dates[-1]); # 1997, 2013, 2025 ... 54 | } 55 | 56 | # Washington’s Birthday, the third Monday in February. 57 | push @dates, $tm->with_month(2) 58 | ->with(ThirdMondayInMonth); 59 | 60 | # Memorial Day, the last Monday in May. 61 | push @dates, $tm->with_month(5) 62 | ->with(LastMondayInMonth); 63 | 64 | # Independence Day, July 4. 65 | push @dates, $tm->with_month(7) 66 | ->with_day_of_month(4) 67 | ->with(NearestWorkday); 68 | 69 | # Labor Day, the first Monday in September. 70 | push @dates, $tm->with_month(9) 71 | ->with(FirstMondayInMonth); 72 | 73 | # Columbus Day, the second Monday in October. 74 | push @dates, $tm->with_month(10) 75 | ->with(SecondMondayInMonth); 76 | 77 | # Veterans Day, November 11. 78 | push @dates, $tm->with_month(11) 79 | ->with_day_of_month(11) 80 | ->with(NearestWorkday); 81 | 82 | # Thanksgiving Day, the fourth Thursday in November. 83 | push @dates, $tm->with_month(11) 84 | ->with(FourthThursdayInMonth); 85 | 86 | # Christmas Day, December 25. 87 | push @dates, $tm->with_month(12) 88 | ->with_day_of_month(25) 89 | ->with(NearestWorkday); 90 | 91 | return @dates; 92 | } 93 | 94 | # Test cases extracted from 95 | my @tests = ( 96 | [ 1997, '1997-01-01', '1997-01-20', '1997-02-17', '1997-05-26', '1997-07-04', 97 | '1997-09-01', '1997-10-13', '1997-11-11', '1997-11-27', '1997-12-25' ], 98 | [ 1998, '1998-01-01', '1998-01-19', '1998-02-16', '1998-05-25', '1998-07-03', 99 | '1998-09-07', '1998-10-12', '1998-11-11', '1998-11-26', '1998-12-25' ], 100 | [ 1999, '1999-01-01', '1999-01-18', '1999-02-15', '1999-05-31', '1999-07-05', 101 | '1999-09-06', '1999-10-11', '1999-11-11', '1999-11-25', '1999-12-24' ], 102 | [ 2000, '1999-12-31', '2000-01-17', '2000-02-21', '2000-05-29', '2000-07-04', 103 | '2000-09-04', '2000-10-09', '2000-11-10', '2000-11-23', '2000-12-25' ], 104 | [ 2001, '2001-01-01', '2001-01-15', '2001-02-19', '2001-05-28', '2001-07-04', 105 | '2001-09-03', '2001-10-08', '2001-11-12', '2001-11-22', '2001-12-25' ], 106 | [ 2002, '2002-01-01', '2002-01-21', '2002-02-18', '2002-05-27', '2002-07-04', 107 | '2002-09-02', '2002-10-14', '2002-11-11', '2002-11-28', '2002-12-25' ], 108 | [ 2003, '2003-01-01', '2003-01-20', '2003-02-17', '2003-05-26', '2003-07-04', 109 | '2003-09-01', '2003-10-13', '2003-11-11', '2003-11-27', '2003-12-25' ], 110 | [ 2004, '2004-01-01', '2004-01-19', '2004-02-16', '2004-05-31', '2004-07-05', 111 | '2004-09-06', '2004-10-11', '2004-11-11', '2004-11-25', '2004-12-24' ], 112 | [ 2005, '2004-12-31', '2005-01-17', '2005-02-21', '2005-05-30', '2005-07-04', 113 | '2005-09-05', '2005-10-10', '2005-11-11', '2005-11-24', '2005-12-26' ], 114 | [ 2006, '2006-01-02', '2006-01-16', '2006-02-20', '2006-05-29', '2006-07-04', 115 | '2006-09-04', '2006-10-09', '2006-11-10', '2006-11-23', '2006-12-25' ], 116 | [ 2007, '2007-01-01', '2007-01-15', '2007-02-19', '2007-05-28', '2007-07-04', 117 | '2007-09-03', '2007-10-08', '2007-11-12', '2007-11-22', '2007-12-25' ], 118 | [ 2008, '2008-01-01', '2008-01-21', '2008-02-18', '2008-05-26', '2008-07-04', 119 | '2008-09-01', '2008-10-13', '2008-11-11', '2008-11-27', '2008-12-25' ], 120 | [ 2009, '2009-01-01', '2009-01-19', '2009-02-16', '2009-05-25', '2009-07-03', 121 | '2009-09-07', '2009-10-12', '2009-11-11', '2009-11-26', '2009-12-25' ], 122 | [ 2010, '2010-01-01', '2010-01-18', '2010-02-15', '2010-05-31', '2010-07-05', 123 | '2010-09-06', '2010-10-11', '2010-11-11', '2010-11-25', '2010-12-24' ], 124 | [ 2011, '2010-12-31', '2011-01-17', '2011-02-21', '2011-05-30', '2011-07-04', 125 | '2011-09-05', '2011-10-10', '2011-11-11', '2011-11-24', '2011-12-26' ], 126 | [ 2012, '2012-01-02', '2012-01-16', '2012-02-20', '2012-05-28', '2012-07-04', 127 | '2012-09-03', '2012-10-08', '2012-11-12', '2012-11-22', '2012-12-25' ], 128 | [ 2013, '2013-01-01', '2013-01-21', '2013-02-18', '2013-05-27', '2013-07-04', 129 | '2013-09-02', '2013-10-14', '2013-11-11', '2013-11-28', '2013-12-25' ], 130 | [ 2014, '2014-01-01', '2014-01-20', '2014-02-17', '2014-05-26', '2014-07-04', 131 | '2014-09-01', '2014-10-13', '2014-11-11', '2014-11-27', '2014-12-25' ], 132 | [ 2015, '2015-01-01', '2015-01-19', '2015-02-16', '2015-05-25', '2015-07-03', 133 | '2015-09-07', '2015-10-12', '2015-11-11', '2015-11-26', '2015-12-25' ], 134 | [ 2016, '2016-01-01', '2016-01-18', '2016-02-15', '2016-05-30', '2016-07-04', 135 | '2016-09-05', '2016-10-10', '2016-11-11', '2016-11-24', '2016-12-26' ], 136 | [ 2017, '2017-01-02', '2017-01-16', '2017-02-20', '2017-05-29', '2017-07-04', 137 | '2017-09-04', '2017-10-09', '2017-11-10', '2017-11-23', '2017-12-25' ], 138 | [ 2018, '2018-01-01', '2018-01-15', '2018-02-19', '2018-05-28', '2018-07-04', 139 | '2018-09-03', '2018-10-08', '2018-11-12', '2018-11-22', '2018-12-25' ], 140 | [ 2019, '2019-01-01', '2019-01-21', '2019-02-18', '2019-05-27', '2019-07-04', 141 | '2019-09-02', '2019-10-14', '2019-11-11', '2019-11-28', '2019-12-25' ], 142 | [ 2020, '2020-01-01', '2020-01-20', '2020-02-17', '2020-05-25', '2020-07-03', 143 | '2020-09-07', '2020-10-12', '2020-11-11', '2020-11-26', '2020-12-25' ], 144 | ); 145 | 146 | use Test::More 0.88; 147 | 148 | foreach my $test (@tests) { 149 | my ($year, @exp) = @$test; 150 | my @got = map { 151 | $_->strftime('%Y-%m-%d') 152 | } compute_us_federal_holidays($year); 153 | is_deeply([@got], [@exp], "U.S. federal holidays for year $year"); 154 | } 155 | 156 | done_testing(); 157 | -------------------------------------------------------------------------------- /lib/Time/Moment.pm: -------------------------------------------------------------------------------- 1 | package Time::Moment; 2 | use strict; 3 | use warnings; 4 | 5 | use Carp qw[]; 6 | 7 | BEGIN { 8 | our $VERSION = '0.44'; 9 | require XSLoader; XSLoader::load(__PACKAGE__, $VERSION); 10 | } 11 | 12 | BEGIN { 13 | unless (exists &Time::Moment::now) { 14 | require Time::HiRes; 15 | eval sprintf <<'EOC', __FILE__; 16 | # line 17 %s 17 | 18 | # expects normalized tm values; algorithm is only valid for tm year's [1, 199] 19 | sub timegm { 20 | my ($y, $d, $h, $m, $s) = @_[5,7,2,1,0]; 21 | return ((1461 * --$y >> 2) + $d - 25202) * 86400 + $h * 3600 + $m * 60 + $s; 22 | } 23 | 24 | sub now { 25 | @_ == 1 || Carp::croak(q/Usage: Time::Moment->now()/); 26 | my ($class) = @_; 27 | 28 | my ($sec, $usec) = Time::HiRes::gettimeofday(); 29 | my $offset = int((timegm(localtime($sec)) - $sec) / 60); 30 | return $class->from_epoch($sec, $usec * 1000) 31 | ->with_offset_same_instant($offset); 32 | } 33 | 34 | sub now_utc { 35 | @_ == 1 || Carp::croak(q/Usage: Time::Moment->now_utc()/); 36 | my ($class) = @_; 37 | 38 | my ($sec, $usec) = Time::HiRes::gettimeofday(); 39 | return $class->from_epoch($sec, $usec * 1000); 40 | } 41 | EOC 42 | die $@ if $@; 43 | } 44 | } 45 | 46 | BEGIN { 47 | delete @Time::Moment::{qw(timegm)}; 48 | } 49 | 50 | sub __as_DateTime { 51 | my ($tm) = @_; 52 | return DateTime->from_epoch( 53 | epoch => $tm->epoch, 54 | time_zone => $tm->strftime('%Z'), 55 | )->set_nanosecond($tm->nanosecond); 56 | } 57 | 58 | sub __as_Time_Piece { 59 | my ($tm) = @_; 60 | return scalar Time::Piece::gmtime($tm->epoch); 61 | } 62 | 63 | sub DateTime::__as_Time_Moment { 64 | my ($dt) = @_; 65 | 66 | (!$dt->time_zone->is_floating) 67 | or Carp::croak(q/Cannot coerce an instance of DateTime in the 'floating' / 68 | .q/time zone to an instance of Time::Moment/); 69 | 70 | return Time::Moment->from_epoch($dt->epoch, $dt->nanosecond) 71 | ->with_offset_same_instant(int($dt->offset / 60)); 72 | } 73 | 74 | sub Time::Piece::__as_Time_Moment { 75 | my ($tp) = @_; 76 | return Time::Moment->from_epoch($tp->epoch) 77 | ->with_offset_same_instant(int($tp->tzoffset / 60)); 78 | } 79 | 80 | sub STORABLE_freeze { 81 | my ($self, $cloning) = @_; 82 | return if $cloning; 83 | return pack 'nnNNN', 0x544D, $self->offset, $self->utc_rd_values; 84 | } 85 | 86 | sub STORABLE_thaw { 87 | my ($self, $cloning, $packed) = @_; 88 | return if $cloning; 89 | (length($packed) == 16 && vec($packed, 0, 16) == 0x544D) # TM 90 | or die(q/Cannot deserialize corrupted data/); # Don't replace die with Carp! 91 | my ($offset, $rdn, $sod, $nos) = unpack 'xxnNNN', $packed; 92 | $offset = ($offset & 0x7FFF) - 0x8000 if ($offset & 0x8000); 93 | my $seconds = ($rdn - 719163) * 86400 + $sod; 94 | $$self = ${ ref($self)->from_epoch($seconds, $nos) 95 | ->with_offset_same_instant($offset) }; 96 | } 97 | 98 | sub TO_JSON { 99 | return $_[0]->to_string; 100 | } 101 | 102 | sub TO_CBOR { 103 | # Use the standard tag for date/time string; see RFC 7049 Section 2.4.1 104 | return CBOR::XS::tag(0, $_[0]->to_string); 105 | } 106 | 107 | sub FREEZE { 108 | return $_[0]->to_string; 109 | } 110 | 111 | sub THAW { 112 | my ($class, undef, $string) = @_; 113 | return $class->from_string($string); 114 | } 115 | 116 | # Alias 117 | *with_offset = \&with_offset_same_instant; 118 | 119 | # used by DateTime::TimeZone 120 | sub utc_year { 121 | return $_[0]->with_offset_same_instant(0)->year; 122 | } 123 | 124 | 1; 125 | 126 | -------------------------------------------------------------------------------- /lib/Time/Moment/Adjusters.pm: -------------------------------------------------------------------------------- 1 | package Time::Moment::Adjusters; 2 | use strict; 3 | use warnings; 4 | 5 | use Carp qw[]; 6 | 7 | BEGIN { 8 | our $VERSION = '0.44'; 9 | our @EXPORT_OK = qw[ NextDayOfWeek 10 | NextOrSameDayOfWeek 11 | PreviousDayOfWeek 12 | PreviousOrSameDayOfWeek 13 | FirstDayOfWeekInMonth 14 | LastDayOfWeekInMonth 15 | NthDayOfWeekInMonth 16 | WesternEasterSunday 17 | OrthodoxEasterSunday 18 | NearestMinuteInterval ]; 19 | 20 | our %EXPORT_TAGS = ( 21 | all => [ @EXPORT_OK ], 22 | ); 23 | 24 | require Exporter; 25 | *import = \&Exporter::import; 26 | } 27 | 28 | sub NextDayOfWeek { 29 | @_ == 1 or Carp::croak(q); 30 | my ($day) = @_; 31 | 32 | ($day >= 1 && $day <= 7) 33 | or Carp::croak(q); 34 | 35 | return sub { 36 | my ($tm) = @_; 37 | return $tm->plus_days(($day - $tm->day_of_week + 6) % 7 + 1); 38 | }; 39 | } 40 | 41 | sub NextOrSameDayOfWeek { 42 | @_ == 1 or Carp::croak(q); 43 | my ($day) = @_; 44 | 45 | ($day >= 1 && $day <= 7) 46 | or Carp::croak(q); 47 | 48 | return sub { 49 | my ($tm) = @_; 50 | return $tm->plus_days(($day - $tm->day_of_week) % 7); 51 | }; 52 | } 53 | 54 | sub PreviousDayOfWeek { 55 | @_ == 1 or Carp::croak(q); 56 | my ($day) = @_; 57 | 58 | ($day >= 1 && $day <= 7) 59 | or Carp::croak(q); 60 | 61 | return sub { 62 | my ($tm) = @_; 63 | return $tm->minus_days(($tm->day_of_week - $day + 6) % 7 + 1); 64 | }; 65 | } 66 | 67 | sub PreviousOrSameDayOfWeek { 68 | @_ == 1 or Carp::croak(q); 69 | my ($day) = @_; 70 | 71 | ($day >= 1 && $day <= 7) 72 | or Carp::croak(q); 73 | 74 | return sub { 75 | my ($tm) = @_; 76 | return $tm->minus_days(($tm->day_of_week - $day) % 7); 77 | }; 78 | } 79 | 80 | sub FirstDayOfWeekInMonth { 81 | @_ == 1 or Carp::croak(q); 82 | my ($day) = @_; 83 | 84 | ($day >= 1 && $day <= 7) 85 | or Carp::croak(q); 86 | 87 | return sub { 88 | my ($tm) = @_; 89 | $tm = $tm->with_day_of_month(1); 90 | return $tm->plus_days(($day - $tm->day_of_week) % 7); 91 | }; 92 | } 93 | 94 | sub LastDayOfWeekInMonth { 95 | @_ == 1 or Carp::croak(q); 96 | my ($day) = @_; 97 | 98 | ($day >= 1 && $day <= 7) 99 | or Carp::croak(q); 100 | 101 | return sub { 102 | my ($tm) = @_; 103 | $tm = $tm->at_last_day_of_month; 104 | return $tm->minus_days(($tm->day_of_week - $day) % 7); 105 | }; 106 | } 107 | 108 | sub NthDayOfWeekInMonth { 109 | @_ == 2 or Carp::croak(q); 110 | my ($ordinal, $day) = @_; 111 | 112 | ($ordinal >= -4 && $ordinal <= 4 && $ordinal != 0) 113 | or Carp::croak(q); 114 | 115 | ($day >= 1 && $day <= 7) 116 | or Carp::croak(q); 117 | 118 | if ($ordinal > 0) { 119 | my $days = 7 * --$ordinal; 120 | return sub { 121 | my ($tm) = @_; 122 | $tm = $tm->with_day_of_month(1); 123 | return $tm->plus_days($days + ($day - $tm->day_of_week) % 7); 124 | }; 125 | } 126 | else { 127 | my $days = 7 * ++$ordinal; 128 | return sub { 129 | my ($tm) = @_; 130 | $tm = $tm->at_last_day_of_month; 131 | return $tm->plus_days($days - ($tm->day_of_week - $day) % 7); 132 | }; 133 | } 134 | } 135 | 136 | sub WesternEasterSunday { 137 | @_ == 0 or Carp::croak(q); 138 | 139 | return sub { 140 | my ($tm) = @_; 141 | return $tm->with_rdn(Time::Moment::Internal::western_easter_sunday($tm->year)); 142 | }; 143 | } 144 | 145 | sub OrthodoxEasterSunday { 146 | @_ == 0 or Carp::croak(q); 147 | 148 | return sub { 149 | my ($tm) = @_; 150 | return $tm->with_rdn(Time::Moment::Internal::orthodox_easter_sunday($tm->year)); 151 | }; 152 | } 153 | 154 | sub NearestMinuteInterval { 155 | @_ == 1 or Carp::croak(q); 156 | my ($interval) = @_; 157 | 158 | ($interval >= 1 && $interval <= 1440) 159 | or Carp::croak(q); 160 | 161 | my $msec = $interval * 60 * 1000; 162 | my $mid = int(($msec + 1) / 2); 163 | return sub { 164 | my ($tm) = @_; 165 | my $msod = $msec * int(($tm->millisecond_of_day + $mid) / $msec); 166 | return $tm->with_millisecond_of_day($msod); 167 | }; 168 | } 169 | 170 | 1; 171 | 172 | -------------------------------------------------------------------------------- /lib/Time/Moment/Adjusters.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 NAME 4 | 5 | Time::Moment::Adjusters - Adjusters for Time::Moment 6 | 7 | =head1 SYNOPSIS 8 | 9 | $adjuster = NextDayOfWeek($day); 10 | $adjuster = NextOrSameDayOfWeek($day); 11 | 12 | $adjuster = PreviousDayOfWeek($day); 13 | $adjuster = PreviousOrSameDayOfWeek($day); 14 | 15 | $adjuster = FirstDayOfWeekInMonth($day); 16 | $adjuster = LastDayOfWeekInMonth($day); 17 | 18 | $adjuster = NthDayOfWeekInMonth($ordinal, $day); 19 | 20 | $adjuster = WesternEasterSunday(); 21 | $adjuster = OrthodoxEasterSunday(); 22 | 23 | $adjuster = NearestMinuteInterval($interval); 24 | 25 | 26 | =head1 DESCRIPTION 27 | 28 | C provides adjusters. An adjuster is a CODE reference 29 | invoked with an instance of Time::Moment and is expected to return an instance 30 | of Time::Moment. 31 | 32 | =head1 FUNCTIONS 33 | 34 | =head2 NextDayOfWeek 35 | 36 | $adjuster = NextDayOfWeek($day); 37 | 38 | The C<$adjuster> adjusts the date to the next occurrence of the given I 39 | of the week [1=Monday, 7=Sunday] that is after the date. 40 | 41 | =head2 NextOrSameDayOfWeek 42 | 43 | $adjuster = NextOrSameDayOfWeek($day); 44 | 45 | The C<$adjuster> adjusts the date to the next occurrence of the given I 46 | of the week [1=Monday, 7=Sunday]. If the date already falls on the given 47 | I of the week it's unaltered. 48 | 49 | =head2 PreviousDayOfWeek 50 | 51 | $adjuster = PreviousDayOfWeek($day); 52 | 53 | The C<$adjuster> adjusts the date to the previous occurrence of the given 54 | I of the week [1=Monday, 7=Sunday] that is before the date. 55 | 56 | =head2 PreviousOrSameDayOfWeek 57 | 58 | $adjuster = PreviousOrSameDayOfWeek($day); 59 | 60 | The C<$adjuster> adjusts the date to the previous occurrence of the given 61 | I of the week [1=Monday, 7=Sunday]. If the date already falls on the 62 | given I of the week it's unaltered. 63 | 64 | =head2 FirstDayOfWeekInMonth 65 | 66 | $adjuster = FirstDayOfWeekInMonth($day); 67 | 68 | The C<$adjuster> adjusts the date to the first occurrence of the given 69 | I of the week [1=Monday, 7=Sunday] within the month. 70 | 71 | =head2 LastDayOfWeekInMonth 72 | 73 | $adjuster = LastDayOfWeekInMonth($day); 74 | 75 | The C<$adjuster> adjusts the date to the last occurrence of the given 76 | I of the week [1=Monday, 7=Sunday] within the month. 77 | 78 | =head2 NthDayOfWeekInMonth 79 | 80 | $adjuster = NthDayOfWeekInMonth($ordinal, $day); 81 | 82 | The C<$adjuster> adjusts the date to the given I I of 83 | the week within the month. 84 | 85 | B 86 | 87 | =over 4 88 | 89 | =item ordinal 90 | 91 | The I of the week within the month [-4, -1] ∪ [1, 4]. 92 | 93 | =item day 94 | 95 | The I of the week [1=Monday, 7=Sunday]. 96 | 97 | =back 98 | 99 | =head2 WesternEasterSunday 100 | 101 | $adjuster = WesternEasterSunday(); 102 | 103 | The C<$adjuster> adjusts the date to the Western Easter Sunday. The Western 104 | computus is based on the Gregorian calendar. 105 | 106 | =head2 OrthodoxEasterSunday 107 | 108 | $adjuster = OrthodoxEasterSunday(); 109 | 110 | The C<$adjuster> adjusts the date to the Orthodox Easter Sunday. The Orthodox 111 | computus is based on the Julian calendar with the Julian date converted to 112 | the equivalent Gregorian date. 113 | 114 | =head2 NearestMinuteInterval 115 | 116 | $adjuster = NearestMinuteInterval($interval); 117 | 118 | The C<$adjuster> adjusts the time of day to the nearest minute of the given 119 | minute I [1, 1440]. 120 | 121 | Given an minute interval of C<30>: 122 | 123 | T10:14:59 => T10:00:00 124 | T10:15:00 => T10:30:00 125 | T10:29:59 => T10:30:00 126 | T23:55:00 => T00:00:00 (midnight of the following day) 127 | 128 | =head1 EXPORTS 129 | 130 | None by default. All functions can be exported using the C<:all> tag or 131 | individually. 132 | 133 | =head1 AUTHOR 134 | 135 | Christian Hansen C 136 | 137 | =head1 COPYRIGHT 138 | 139 | Copyright 2015-2017 by Christian Hansen. 140 | 141 | This is free software; you can redistribute it and/or modify it under 142 | the same terms as the Perl 5 programming language system itself. 143 | 144 | -------------------------------------------------------------------------------- /src/dt_accessor.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #include 27 | #include "dt_core.h" 28 | 29 | dt_t 30 | dt_from_cjdn(int n) { 31 | return dt_from_rdn(n - 1721425); 32 | } 33 | 34 | int 35 | dt_cjdn(dt_t dt) { 36 | return dt_rdn(dt) + 1721425; 37 | } 38 | 39 | int 40 | dt_year(dt_t dt) { 41 | int y; 42 | dt_to_yd(dt, &y, NULL); 43 | return y; 44 | } 45 | 46 | int 47 | dt_quarter(dt_t dt) { 48 | int q; 49 | dt_to_yqd(dt, NULL, &q, NULL); 50 | return q; 51 | } 52 | 53 | int 54 | dt_month(dt_t dt) { 55 | int m; 56 | dt_to_ymd(dt, NULL, &m, NULL); 57 | return m; 58 | } 59 | 60 | int 61 | dt_doy(dt_t dt) { 62 | int d; 63 | dt_to_yd(dt, NULL, &d); 64 | return d; 65 | } 66 | 67 | int 68 | dt_doq(dt_t dt) { 69 | int d; 70 | dt_to_yqd(dt, NULL, NULL, &d); 71 | return d; 72 | } 73 | 74 | int 75 | dt_dom(dt_t dt) { 76 | int d; 77 | dt_to_ymd(dt, NULL, NULL, &d); 78 | return d; 79 | } 80 | 81 | int 82 | dt_woy(dt_t dt) { 83 | int w; 84 | dt_to_ywd(dt, NULL, &w, NULL); 85 | return w; 86 | } 87 | 88 | int 89 | dt_yow(dt_t dt) { 90 | int y; 91 | dt_to_ywd(dt, &y, NULL, NULL); 92 | return y; 93 | } 94 | 95 | -------------------------------------------------------------------------------- /src/dt_accessor.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_ACCESSOR_H__ 27 | #define __DT_ACCESSOR_H__ 28 | #include "dt_core.h" 29 | 30 | #ifdef __cplusplus 31 | extern "C" { 32 | #endif 33 | 34 | dt_t dt_from_cjdn (int n); 35 | 36 | int dt_cjdn (dt_t dt); 37 | 38 | int dt_year (dt_t dt); 39 | int dt_quarter (dt_t dt); 40 | int dt_month (dt_t dt); 41 | 42 | int dt_doy (dt_t dt); 43 | int dt_doq (dt_t dt); 44 | int dt_dom (dt_t dt); 45 | 46 | int dt_woy (dt_t dt); 47 | int dt_yow (dt_t dt); 48 | 49 | #ifdef __cplusplus 50 | } 51 | #endif 52 | #endif 53 | 54 | -------------------------------------------------------------------------------- /src/dt_arithmetic.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #include "dt_core.h" 27 | #include "dt_util.h" 28 | #include "dt_arithmetic.h" 29 | 30 | dt_t 31 | dt_add_years(dt_t dt, int delta, dt_adjust_t adjust) { 32 | int y, d; 33 | 34 | dt_to_yd(dt, &y, &d); 35 | if (adjust == DT_EXCESS || d < 365) 36 | return dt_from_yd(y + delta, d); 37 | else { 38 | int ry = y + delta; 39 | int diy; 40 | 41 | diy = dt_days_in_year(ry); 42 | if (d > diy || (adjust == DT_SNAP && d == dt_days_in_year(y))) 43 | d = diy; 44 | return dt_from_yd(ry, d); 45 | } 46 | } 47 | 48 | dt_t 49 | dt_add_quarters(dt_t dt, int delta, dt_adjust_t adjust) { 50 | int y, q, d; 51 | 52 | dt_to_yqd(dt, &y, &q, &d); 53 | if (adjust == DT_EXCESS || d < 90) 54 | return dt_from_yqd(y, q + delta, d); 55 | else { 56 | int ry = y; 57 | int rq = q + delta; 58 | int diq; 59 | 60 | if (rq < 1 || rq > 4) { 61 | ry += rq / 4; 62 | rq %= 4; 63 | if (rq < 1) 64 | ry--, rq += 4; 65 | } 66 | 67 | diq = dt_days_in_quarter(ry, rq); 68 | if (d > diq || (adjust == DT_SNAP && d == dt_days_in_quarter(y, q))) 69 | d = diq; 70 | return dt_from_yqd(ry, rq, d); 71 | } 72 | } 73 | 74 | dt_t 75 | dt_add_months(dt_t dt, int delta, dt_adjust_t adjust) { 76 | int y, m, d; 77 | 78 | dt_to_ymd(dt, &y, &m, &d); 79 | if (adjust == DT_EXCESS || d < 28) 80 | return dt_from_ymd(y, m + delta, d); 81 | else { 82 | int ry = y; 83 | int rm = m + delta; 84 | int dim; 85 | 86 | if (rm < 1 || rm > 12) { 87 | ry += rm / 12; 88 | rm %= 12; 89 | if (rm < 1) 90 | ry--, rm += 12; 91 | } 92 | 93 | dim = dt_days_in_month(ry, rm); 94 | if (d > dim || (adjust == DT_SNAP && d == dt_days_in_month(y, m))) 95 | d = dim; 96 | return dt_from_ymd(ry, rm, d); 97 | } 98 | } 99 | 100 | void 101 | dt_delta_yd(dt_t dt1, dt_t dt2, int *yp, int *dp) { 102 | int y1, y2, d1, d2, ny, nd; 103 | 104 | dt_to_yd(dt1, &y1, &d1); 105 | dt_to_yd(dt2, &y2, &d2); 106 | 107 | ny = y2 - y1; 108 | nd = d2 - d1; 109 | 110 | if (ny > 0 && nd < 0) { 111 | ny--; 112 | nd = dt2 - dt_add_years(dt1, ny, DT_LIMIT); 113 | } 114 | else if (ny < 0 && nd > 0) { 115 | ny++; 116 | nd -= dt_days_in_year(y2); 117 | } 118 | 119 | if (yp) *yp = ny; 120 | if (dp) *dp = nd; 121 | } 122 | 123 | void 124 | dt_delta_yqd(dt_t dt1, dt_t dt2, int *yp, int *qp, int *dp) { 125 | int y1, y2, q1, q2, d1, d2, ny, nq, nd; 126 | 127 | dt_to_yqd(dt1, &y1, &q1, &d1); 128 | dt_to_yqd(dt2, &y2, &q2, &d2); 129 | 130 | nq = 4 * (y2 - y1) + q2 - q1; 131 | nd = d2 - d1; 132 | 133 | if (nq > 0 && nd < 0) { 134 | nq--; 135 | nd = dt2 - dt_add_quarters(dt1, nq, DT_LIMIT); 136 | } 137 | else if (nq < 0 && nd > 0) { 138 | nq++; 139 | nd -= dt_days_in_quarter(y2, q2); 140 | } 141 | 142 | ny = nq / 4; 143 | nq = nq - ny * 4; 144 | 145 | if (qp) *yp = ny; 146 | if (qp) *qp = nq; 147 | if (dp) *dp = nd; 148 | } 149 | 150 | void 151 | dt_delta_ymd(dt_t dt1, dt_t dt2, int *yp, int *mp, int *dp) { 152 | int y1, y2, m1, m2, d1, d2, ny, nm, nd; 153 | 154 | dt_to_ymd(dt1, &y1, &m1, &d1); 155 | dt_to_ymd(dt2, &y2, &m2, &d2); 156 | 157 | nm = 12 * (y2 - y1) + m2 - m1; 158 | nd = d2 - d1; 159 | 160 | if (nm > 0 && nd < 0) { 161 | nm--; 162 | nd = dt2 - dt_add_months(dt1, nm, DT_LIMIT); 163 | } 164 | else if (nm < 0 && nd > 0) { 165 | nm++; 166 | nd -= dt_days_in_month(y2, m2); 167 | } 168 | 169 | ny = nm / 12; 170 | nm = nm - ny * 12; 171 | 172 | if (yp) *yp = ny; 173 | if (mp) *mp = nm; 174 | if (dp) *dp = nd; 175 | } 176 | 177 | int 178 | dt_delta_years(dt_t dt1, dt_t dt2, bool complete) { 179 | int y1, y2, d1, d2, ny; 180 | 181 | dt_to_yd(dt1, &y1, &d1); 182 | dt_to_yd(dt2, &y2, &d2); 183 | 184 | ny = y2 - y1; 185 | if (complete) { 186 | if (dt1 > dt2) 187 | ny += (d2 > d1); 188 | else 189 | ny -= (d1 > d2); 190 | } 191 | return ny; 192 | } 193 | 194 | int 195 | dt_delta_quarters(dt_t dt1, dt_t dt2, bool complete) { 196 | int y1, y2, q1, q2, d1, d2, nq; 197 | 198 | dt_to_yqd(dt1, &y1, &q1, &d1); 199 | dt_to_yqd(dt2, &y2, &q2, &d2); 200 | 201 | nq = 4 * (y2 - y1) + q2 - q1; 202 | if (complete) { 203 | if (dt1 > dt2) 204 | nq += (d2 > d1); 205 | else 206 | nq -= (d1 > d2); 207 | } 208 | return nq; 209 | } 210 | 211 | int 212 | dt_delta_months(dt_t dt1, dt_t dt2, bool complete) { 213 | int y1, y2, m1, m2, d1, d2, nm; 214 | 215 | dt_to_ymd(dt1, &y1, &m1, &d1); 216 | dt_to_ymd(dt2, &y2, &m2, &d2); 217 | 218 | nm = 12 * (y2 - y1) + m2 - m1; 219 | if (complete) { 220 | if (dt1 > dt2) 221 | nm += (d2 > d1); 222 | else 223 | nm -= (d1 > d2); 224 | } 225 | return nm; 226 | } 227 | 228 | int 229 | dt_delta_weeks(dt_t dt1, dt_t dt2) { 230 | return (dt2 - dt1) / 7; 231 | } 232 | 233 | -------------------------------------------------------------------------------- /src/dt_arithmetic.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_ARITHMETIC_H__ 27 | #define __DT_ARITHMETIC_H__ 28 | #include "dt_core.h" 29 | 30 | #ifdef __cplusplus 31 | extern "C" { 32 | #endif 33 | 34 | typedef enum { 35 | DT_EXCESS, 36 | DT_LIMIT, 37 | DT_SNAP 38 | } dt_adjust_t; 39 | 40 | dt_t dt_add_years (dt_t dt, int delta, dt_adjust_t adjust); 41 | dt_t dt_add_quarters (dt_t dt, int delta, dt_adjust_t adjust); 42 | dt_t dt_add_months (dt_t dt, int delta, dt_adjust_t adjust); 43 | 44 | void dt_delta_yd (dt_t start, dt_t end, int *y, int *d); 45 | void dt_delta_ymd (dt_t start, dt_t end, int *y, int *m, int *d); 46 | void dt_delta_yqd (dt_t start, dt_t end, int *y, int *q, int *d); 47 | 48 | int dt_delta_years (dt_t start, dt_t end, bool complete); 49 | int dt_delta_quarters (dt_t start, dt_t end, bool complete); 50 | int dt_delta_months (dt_t start, dt_t end, bool complete); 51 | int dt_delta_weeks (dt_t start, dt_t end); 52 | 53 | #ifdef __cplusplus 54 | } 55 | #endif 56 | #endif 57 | 58 | -------------------------------------------------------------------------------- /src/dt_config.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_CONFIG_H__ 27 | #define __DT_CONFIG_H__ 28 | 29 | #if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \ 30 | (defined(__GNUC__) && __GNUC__ >= 3) || \ 31 | (defined(_MSC_VER) && _MSC_VER >= 1800) 32 | # include 33 | #endif 34 | 35 | #if !defined(__cplusplus) && !defined(__bool_true_false_are_defined) 36 | typedef char _Bool; 37 | # define bool _Bool 38 | # define true 1 39 | # define false 0 40 | # define __bool_true_false_are_defined 1 41 | #endif 42 | 43 | /* Chronological Julian Date, January 1, 4713 BC, Monday 44 | #define DT_EPOCH_OFFSET 1721425 45 | */ 46 | 47 | /* Network Time Protocol (NTP), January 1, 1900, Monday 48 | #define DT_EPOCH_OFFSET -693596 49 | */ 50 | 51 | /* Unix, January 1, 1970, Thursday 52 | #define DT_EPOCH_OFFSET -719163 53 | */ 54 | 55 | /* Rata Die, January 1, 0001, Monday (as Day 1) */ 56 | #define DT_EPOCH_OFFSET 0 57 | 58 | #ifdef __cplusplus 59 | extern "C" { 60 | #endif 61 | 62 | typedef int dt_t; 63 | 64 | #ifdef __cplusplus 65 | } 66 | #endif 67 | #endif 68 | -------------------------------------------------------------------------------- /src/dt_core.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #include 27 | #include "dt_core.h" 28 | 29 | #define LEAP_YEAR(y) \ 30 | (((y) & 3) == 0 && ((y) % 100 != 0 || (y) % 400 == 0)) 31 | 32 | #define DAYS_IN_YEAR(y) \ 33 | (LEAP_YEAR(y) ? 366 : 365) 34 | 35 | static const int days_preceding_month[2][13] = { 36 | { 0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 }, 37 | { 0, 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335 } 38 | }; 39 | 40 | static const int days_preceding_quarter[2][5] = { 41 | { 0, 0, 90, 181, 273 }, 42 | { 0, 0, 91, 182, 274 } 43 | }; 44 | 45 | dt_t 46 | dt_from_rdn(int n) { 47 | return n + DT_EPOCH_OFFSET; 48 | } 49 | 50 | dt_t 51 | dt_from_yd(int y, int d) { 52 | y--; 53 | if (y < 0) { 54 | const int n400 = 1 - y/400; 55 | y += n400 * 400; 56 | d -= n400 * 146097; 57 | } 58 | return 365 * y + y/4 - y/100 + y/400 + d + DT_EPOCH_OFFSET; 59 | } 60 | 61 | dt_t 62 | dt_from_ymd(int y, int m, int d) { 63 | if (m < 1 || m > 12) { 64 | y += m / 12; 65 | m %= 12; 66 | if (m < 1) 67 | y--, m += 12; 68 | } 69 | assert(m >= 1); 70 | assert(m <= 12); 71 | return dt_from_yd(y, days_preceding_month[LEAP_YEAR(y)][m] + d); 72 | } 73 | 74 | dt_t 75 | dt_from_yqd(int y, int q, int d) { 76 | if (q < 1 || q > 4) { 77 | y += q / 4; 78 | q %= 4; 79 | if (q < 1) 80 | y--, q += 4; 81 | } 82 | assert(q >= 1); 83 | assert(q <= 4); 84 | return dt_from_yd(y, days_preceding_quarter[LEAP_YEAR(y)][q] + d); 85 | } 86 | 87 | dt_t 88 | dt_from_ywd(int y, int w, int d) { 89 | dt_t dt; 90 | 91 | dt = dt_from_yd(y, 4); 92 | dt -= dt_dow(dt); 93 | dt += w * 7 + d - 7; 94 | return dt; 95 | } 96 | 97 | 98 | #ifndef DT_NO_SHORTCUTS 99 | static const dt_t DT1901 = 693961 + DT_EPOCH_OFFSET; /* 1901-01-01 */ 100 | static const dt_t DT2099 = 766644 + DT_EPOCH_OFFSET; /* 2099-12-31 */ 101 | #endif 102 | 103 | void 104 | dt_to_yd(dt_t d, int *yp, int *dp) { 105 | int y, n100, n1; 106 | 107 | y = 0; 108 | #ifndef DT_NO_SHORTCUTS 109 | /* Shortcut dates between the years 1901-2099 inclusive */ 110 | if (d >= DT1901 && d <= DT2099) { 111 | d -= DT1901 - 1; 112 | y += (4 * d - 1) / 1461; 113 | d -= (1461 * y) / 4; 114 | y += 1901; 115 | } 116 | else 117 | #endif 118 | { 119 | d -= DT_EPOCH_OFFSET; 120 | if (d < 1) { 121 | const int n400 = 1 - d/146097; 122 | y -= n400 * 400; 123 | d += n400 * 146097; 124 | } 125 | d--; 126 | y += 400 * (d / 146097); 127 | d %= 146097; 128 | 129 | n100 = d / 36524; 130 | y += 100 * n100; 131 | d %= 36524; 132 | 133 | y += 4 * (d / 1461); 134 | d %= 1461; 135 | 136 | n1 = d / 365; 137 | y += n1; 138 | d %= 365; 139 | 140 | if (n100 == 4 || n1 == 4) 141 | d = 366; 142 | else 143 | y++, d++; 144 | } 145 | if (yp) *yp = y; 146 | if (dp) *dp = (int)d; 147 | } 148 | 149 | void 150 | dt_to_ymd(dt_t dt, int *yp, int *mp, int *dp) { 151 | int y, doy, m, l; 152 | 153 | dt_to_yd(dt, &y, &doy); 154 | l = LEAP_YEAR(y); 155 | m = doy < 32 ? 1 : 1 + (5 * (doy - 59 - l) + 303) / 153; 156 | 157 | assert(m >= 1); 158 | assert(m <= 12); 159 | 160 | if (yp) *yp = y; 161 | if (mp) *mp = m; 162 | if (dp) *dp = doy - days_preceding_month[l][m]; 163 | } 164 | 165 | void 166 | dt_to_yqd(dt_t dt, int *yp, int *qp, int *dp) { 167 | int y, doy, q, l; 168 | 169 | dt_to_yd(dt, &y, &doy); 170 | l = LEAP_YEAR(y); 171 | q = doy < 91 ? 1 : 1 + (5 * (doy - 59 - l) + 303) / 459; 172 | 173 | assert(q >= 1); 174 | assert(q <= 4); 175 | 176 | if (yp) *yp = y; 177 | if (qp) *qp = q; 178 | if (dp) *dp = doy - days_preceding_quarter[l][q]; 179 | } 180 | 181 | void 182 | dt_to_ywd(dt_t dt, int *yp, int *wp, int *dp) { 183 | int y, doy, dow; 184 | 185 | dt_to_yd(dt, &y, &doy); 186 | dow = dt_dow(dt); 187 | doy = doy + 4 - dow; 188 | if (doy < 1) { 189 | y--; 190 | doy += DAYS_IN_YEAR(y); 191 | } 192 | else if (doy > 365) { 193 | const int diy = DAYS_IN_YEAR(y); 194 | if (doy > diy) { 195 | doy -= diy; 196 | y++; 197 | } 198 | } 199 | if (yp) *yp = y; 200 | if (wp) *wp = (doy + 6) / 7; 201 | if (dp) *dp = dow; 202 | } 203 | 204 | int 205 | dt_rdn(dt_t dt) { 206 | return dt - DT_EPOCH_OFFSET; 207 | } 208 | 209 | dt_dow_t 210 | dt_dow(dt_t dt) { 211 | int dow = (dt - DT_EPOCH_OFFSET) % 7; 212 | if (dow < 1) 213 | dow += 7; 214 | assert(dow >= 1); 215 | assert(dow <= 7); 216 | return dow; 217 | } 218 | 219 | -------------------------------------------------------------------------------- /src/dt_core.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_CORE_H__ 27 | #define __DT_CORE_H__ 28 | #include "dt_config.h" 29 | 30 | #ifdef __cplusplus 31 | extern "C" { 32 | #endif 33 | 34 | typedef enum { 35 | DT_MON = 1, 36 | DT_MONDAY = 1, 37 | DT_TUE = 2, 38 | DT_TUESDAY = 2, 39 | DT_WED = 3, 40 | DT_WEDNESDAY = 3, 41 | DT_THU = 4, 42 | DT_THURSDAY = 4, 43 | DT_FRI = 5, 44 | DT_FRIDAY = 5, 45 | DT_SAT = 6, 46 | DT_SATURDAY = 6, 47 | DT_SUN = 7, 48 | DT_SUNDAY = 7, 49 | } dt_dow_t; 50 | 51 | dt_t dt_from_rdn (int n); 52 | dt_t dt_from_yd (int y, int d); 53 | dt_t dt_from_ymd (int y, int m, int d); 54 | dt_t dt_from_yqd (int y, int q, int d); 55 | dt_t dt_from_ywd (int y, int w, int d); 56 | 57 | void dt_to_yd (dt_t dt, int *y, int *d); 58 | void dt_to_ymd (dt_t dt, int *y, int *m, int *d); 59 | void dt_to_yqd (dt_t dt, int *y, int *q, int *d); 60 | void dt_to_ywd (dt_t dt, int *y, int *w, int *d); 61 | 62 | int dt_rdn (dt_t dt); 63 | dt_dow_t dt_dow (dt_t dt); 64 | 65 | #ifdef __cplusplus 66 | } 67 | #endif 68 | #endif 69 | 70 | -------------------------------------------------------------------------------- /src/dt_easter.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2015 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #include "dt_core.h" 27 | #include "dt_easter.h" 28 | 29 | /* 30 | * Easter algorithms by Al Petrofsky, San Mateo County, California, U.S.A. 31 | * 32 | */ 33 | static int 34 | easter_gregorian(unsigned int y) { 35 | unsigned int a, b; 36 | a = y/100 * 1483 - y/400 * 2225 + 2613; 37 | b = ((y % 19 * 3510 + a/25 * 319) / 330) % 29; 38 | return 56 - b - ((y * 5/4) + a - b) % 7; 39 | } 40 | 41 | static int 42 | easter_julian(unsigned int y) { 43 | unsigned int a; 44 | a = (y % 19 * 19 + 15) % 30; 45 | return 28 + a - ((y * 5/4) + a) % 7; 46 | } 47 | 48 | dt_t 49 | dt_from_easter(int y, dt_computus_t computus) { 50 | if (y < 1) 51 | return 0; 52 | if (computus == DT_WESTERN) 53 | return dt_from_ymd(y, 3, easter_gregorian(y)); 54 | else 55 | return dt_from_ymd(y, 3, easter_julian(y) + y/100 - y/400 - 2); 56 | } 57 | 58 | -------------------------------------------------------------------------------- /src/dt_easter.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2015 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_EASTER_H__ 27 | #define __DT_EASTER_H__ 28 | #include "dt_core.h" 29 | 30 | #ifdef __cplusplus 31 | extern "C" { 32 | #endif 33 | 34 | typedef enum { 35 | DT_ORTHODOX, 36 | DT_WESTERN 37 | } dt_computus_t; 38 | 39 | dt_t dt_from_easter (int y, dt_computus_t computus); 40 | 41 | #ifdef __cplusplus 42 | } 43 | #endif 44 | #endif 45 | 46 | -------------------------------------------------------------------------------- /src/dt_length.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #include 27 | #include "dt_core.h" 28 | #include "dt_util.h" 29 | 30 | int 31 | dt_length_of_year(dt_t dt) { 32 | int y; 33 | dt_to_yd(dt, &y, NULL); 34 | return dt_days_in_year(y); 35 | } 36 | 37 | int 38 | dt_length_of_quarter(dt_t dt) { 39 | int y, q; 40 | dt_to_yqd(dt, &y, &q, NULL); 41 | return dt_days_in_quarter(y, q); 42 | } 43 | 44 | int 45 | dt_length_of_month(dt_t dt) { 46 | int y, m; 47 | dt_to_ymd(dt, &y, &m, NULL); 48 | return dt_days_in_month(y, m); 49 | } 50 | 51 | int 52 | dt_length_of_week_year(dt_t dt) { 53 | int y; 54 | dt_to_yd(dt, &y, NULL); 55 | return dt_weeks_in_year(y); 56 | } 57 | -------------------------------------------------------------------------------- /src/dt_length.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_LENGTH_H__ 27 | #define __DT_LENGTH_H__ 28 | #include "dt_core.h" 29 | 30 | #ifdef __cplusplus 31 | extern "C" { 32 | #endif 33 | 34 | int dt_length_of_year (dt_t dt); 35 | int dt_length_of_quarter (dt_t dt); 36 | int dt_length_of_month (dt_t dt); 37 | int dt_length_of_week_year (dt_t dt); 38 | 39 | #ifdef __cplusplus 40 | } 41 | #endif 42 | #endif 43 | 44 | -------------------------------------------------------------------------------- /src/dt_parse_iso.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_PARSE_H__ 27 | #define __DT_PARSE_H__ 28 | #include 29 | #include "dt_core.h" 30 | 31 | #ifdef __cplusplus 32 | extern "C" { 33 | #endif 34 | 35 | size_t dt_parse_iso_date (const char *str, size_t len, dt_t *dt); 36 | 37 | size_t dt_parse_iso_time (const char *str, size_t len, int *sod, int *nsec); 38 | size_t dt_parse_iso_time_basic (const char *str, size_t len, int *sod, int *nsec); 39 | size_t dt_parse_iso_time_extended (const char *str, size_t len, int *sod, int *nsec); 40 | 41 | size_t dt_parse_iso_zone (const char *str, size_t len, int *offset); 42 | size_t dt_parse_iso_zone_basic (const char *str, size_t len, int *offset); 43 | size_t dt_parse_iso_zone_extended (const char *str, size_t len, int *offset); 44 | size_t dt_parse_iso_zone_lenient (const char *str, size_t len, int *offset); 45 | 46 | #ifdef __cplusplus 47 | } 48 | #endif 49 | #endif 50 | 51 | -------------------------------------------------------------------------------- /src/dt_util.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #include "dt_core.h" 27 | 28 | bool 29 | dt_leap_year(int y) { 30 | return ((y & 3) == 0 && (y % 100 != 0 || y % 400 == 0)); 31 | } 32 | 33 | int 34 | dt_days_in_year(int y) { 35 | return dt_leap_year(y) ? 366 : 365; 36 | } 37 | 38 | int 39 | dt_days_in_quarter(int y, int q) { 40 | static const int days_in_quarter[2][5] = { 41 | { 0, 90, 91, 92, 92 }, 42 | { 0, 91, 91, 92, 92 } 43 | }; 44 | if (q < 1 || q > 4) 45 | return 0; 46 | return days_in_quarter[dt_leap_year(y)][q]; 47 | } 48 | 49 | int 50 | dt_days_in_month(int y, int m) { 51 | static const int days_in_month[2][13] = { 52 | { 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 }, 53 | { 0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 } 54 | }; 55 | if (m < 1 || m > 12) 56 | return 0; 57 | return days_in_month[dt_leap_year(y)][m]; 58 | } 59 | 60 | int 61 | dt_weeks_in_year(int year) { 62 | unsigned int y, d; 63 | if (year < 1) 64 | year += 400 * (1 - year/400); 65 | y = year - 1; 66 | d = (y + y/4 - y/100 + y/400) % 7; /* Mon = 0, ... Sun = 6 */ 67 | return (d == 3 || (d == 2 && dt_leap_year(year))) ? 53 : 52; 68 | } 69 | 70 | -------------------------------------------------------------------------------- /src/dt_util.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_UTIL_H__ 27 | #define __DT_UTIL_H__ 28 | #include "dt_core.h" 29 | 30 | #ifdef __cplusplus 31 | extern "C" { 32 | #endif 33 | 34 | bool dt_leap_year (int y); 35 | int dt_days_in_year (int y); 36 | int dt_days_in_quarter (int y, int q); 37 | int dt_days_in_month (int y, int m); 38 | int dt_weeks_in_year (int y); 39 | 40 | #ifdef __cplusplus 41 | } 42 | #endif 43 | #endif 44 | 45 | -------------------------------------------------------------------------------- /src/dt_valid.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #include "dt_core.h" 27 | #include "dt_util.h" 28 | 29 | bool 30 | dt_valid_yd(int y, int d) { 31 | return (d >= 1 && (d <= 365 || d == dt_days_in_year(y))); 32 | } 33 | 34 | bool 35 | dt_valid_ymd(int y, int m, int d) { 36 | return ((m >= 1 && m <= 12) && 37 | (d >= 1 && (d <= 28 || d <= dt_days_in_month(y, m)))); 38 | } 39 | 40 | bool 41 | dt_valid_yqd(int y, int q, int d) { 42 | return ((q >= 1 && q <= 4) && 43 | (d >= 1 && (d <= 90 || d <= dt_days_in_quarter(y, q)))); 44 | } 45 | 46 | bool 47 | dt_valid_ywd(int y, int w, int d) { 48 | return ((d >= 1 && d <= 7) && 49 | (w >= 1 && (w <= 52 || w == dt_weeks_in_year(y)))); 50 | } 51 | 52 | -------------------------------------------------------------------------------- /src/dt_valid.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright (c) 2012-2014 Christian Hansen 3 | * 4 | * All rights reserved. 5 | * 6 | * Redistribution and use in source and binary forms, with or without 7 | * modification, are permitted provided that the following conditions are met: 8 | * 9 | * 1. Redistributions of source code must retain the above copyright notice, this 10 | * list of conditions and the following disclaimer. 11 | * 2. Redistributions in binary form must reproduce the above copyright notice, 12 | * this list of conditions and the following disclaimer in the documentation 13 | * and/or other materials provided with the distribution. 14 | * 15 | * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 19 | * ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | */ 26 | #ifndef __DT_VALID_H__ 27 | #define __DT_VALID_H__ 28 | #include "dt_core.h" 29 | 30 | #ifdef __cplusplus 31 | extern "C" { 32 | #endif 33 | 34 | bool dt_valid_yd (int y, int d); 35 | bool dt_valid_ymd (int y, int m, int d); 36 | bool dt_valid_yqd (int y, int q, int d); 37 | bool dt_valid_ywd (int y, int w, int d); 38 | 39 | #ifdef __cplusplus 40 | } 41 | #endif 42 | #endif 43 | 44 | -------------------------------------------------------------------------------- /src/moment.h: -------------------------------------------------------------------------------- 1 | #ifndef __MOMENT_H__ 2 | #define __MOMENT_H__ 3 | #define PERL_NO_GET_CONTEXT 4 | #include "EXTERN.h" 5 | #include "perl.h" 6 | #include "dt_core.h" 7 | 8 | #ifndef _MSC_VER 9 | # include 10 | #else 11 | # if _MSC_VER >= 1600 12 | # include 13 | # else 14 | typedef __int32 int32_t; 15 | typedef __int64 int64_t; 16 | typedef unsigned __int32 uint32_t; 17 | typedef unsigned __int64 uint64_t; 18 | # endif 19 | # ifndef INT64_C 20 | # define INT64_C(x) x##i64 21 | # endif 22 | #endif 23 | 24 | #define SECS_PER_DAY 86400 25 | #define NANOS_PER_SEC 1000000000 26 | 27 | #define MIN_UNIT_YEARS INT64_C(-10000) 28 | #define MAX_UNIT_YEARS INT64_C(10000) 29 | #define MIN_UNIT_MONTHS INT64_C(-120000) 30 | #define MAX_UNIT_MONTHS INT64_C(120000) 31 | #define MIN_UNIT_WEEKS INT64_C(-521775) 32 | #define MAX_UNIT_WEEKS INT64_C(521775) 33 | #define MIN_UNIT_DAYS INT64_C(-3652425) 34 | #define MAX_UNIT_DAYS INT64_C(3652425) 35 | #define MIN_UNIT_HOURS INT64_C(-87658200) 36 | #define MAX_UNIT_HOURS INT64_C(87658200) 37 | #define MIN_UNIT_MINUTES INT64_C(-5259492000) 38 | #define MAX_UNIT_MINUTES INT64_C(5259492000) 39 | #define MIN_UNIT_SECONDS INT64_C(-315569520000) 40 | #define MAX_UNIT_SECONDS INT64_C(315569520000) 41 | #define MIN_UNIT_MILLIS INT64_C(-315569520000000) 42 | #define MAX_UNIT_MILLIS INT64_C(315569520000000) 43 | #define MIN_UNIT_MICROS INT64_C(-315569520000000000) 44 | #define MAX_UNIT_MICROS INT64_C(315569520000000000) 45 | 46 | #define MIN_RATA_DIE_DAY INT64_C(1) /* 0001-01-01 */ 47 | #define MAX_RATA_DIE_DAY INT64_C(3652059) /* 9999-12-31 */ 48 | 49 | #define MIN_RANGE INT64_C(86400) /* 0001-01-01T00:00:00Z */ 50 | #define MAX_RANGE INT64_C(315537983999) /* 9999-12-31T23:59:59Z */ 51 | #define UNIX_EPOCH INT64_C(62135683200) /* 1970-01-01T00:00:00Z */ 52 | #define MIN_EPOCH_SEC INT64_C(-62135596800) /* 0001-01-01T00:00:00Z */ 53 | #define MAX_EPOCH_SEC INT64_C(253402300799) /* 9999-12-31T23:59:59Z */ 54 | 55 | #define VALID_EPOCH_SEC(s) \ 56 | (s >= MIN_EPOCH_SEC && s <= MAX_EPOCH_SEC) 57 | 58 | typedef struct { 59 | int64_t sec; 60 | int32_t nsec; 61 | int32_t offset; 62 | } moment_t; 63 | 64 | typedef struct { 65 | int64_t sec; 66 | int32_t nsec; 67 | } moment_duration_t; 68 | 69 | typedef enum { 70 | MOMENT_UNIT_YEARS=0, 71 | MOMENT_UNIT_MONTHS, 72 | MOMENT_UNIT_WEEKS, 73 | MOMENT_UNIT_DAYS, 74 | MOMENT_UNIT_HOURS, 75 | MOMENT_UNIT_MINUTES, 76 | MOMENT_UNIT_SECONDS, 77 | MOMENT_UNIT_MILLIS, 78 | MOMENT_UNIT_MICROS, 79 | MOMENT_UNIT_NANOS, 80 | } moment_unit_t; 81 | 82 | typedef enum { 83 | MOMENT_FIELD_YEAR=0, 84 | MOMENT_FIELD_QUARTER_OF_YEAR, 85 | MOMENT_FIELD_MONTH_OF_YEAR, 86 | MOMENT_FIELD_WEEK_OF_YEAR, 87 | MOMENT_FIELD_DAY_OF_YEAR, 88 | MOMENT_FIELD_DAY_OF_QUARTER, 89 | MOMENT_FIELD_DAY_OF_MONTH, 90 | MOMENT_FIELD_DAY_OF_WEEK, 91 | MOMENT_FIELD_HOUR_OF_DAY, 92 | MOMENT_FIELD_MINUTE_OF_HOUR, 93 | MOMENT_FIELD_MINUTE_OF_DAY, 94 | MOMENT_FIELD_SECOND_OF_MINUTE, 95 | MOMENT_FIELD_SECOND_OF_DAY, 96 | MOMENT_FIELD_MILLI_OF_SECOND, 97 | MOMENT_FIELD_MILLI_OF_DAY, 98 | MOMENT_FIELD_MICRO_OF_SECOND, 99 | MOMENT_FIELD_MICRO_OF_DAY, 100 | MOMENT_FIELD_NANO_OF_SECOND, 101 | MOMENT_FIELD_NANO_OF_DAY, 102 | MOMENT_FIELD_PRECISION, 103 | MOMENT_FIELD_RATA_DIE_DAY, 104 | } moment_component_t; 105 | 106 | moment_t THX_moment_new(pTHX_ IV Y, IV M, IV D, IV h, IV m, IV s, IV ns, IV offset); 107 | moment_t THX_moment_from_epoch(pTHX_ int64_t sec, IV usec, IV offset); 108 | moment_t THX_moment_from_epoch_nv(pTHX_ NV sec, IV precision); 109 | 110 | moment_t THX_moment_from_rd(pTHX_ NV jd, NV epoch, IV precision, IV offset); 111 | moment_t THX_moment_from_jd(pTHX_ NV jd, NV epoch, IV precision); 112 | moment_t THX_moment_from_mjd(pTHX_ NV jd, NV epoch, IV precision); 113 | 114 | moment_t THX_moment_with_field(pTHX_ const moment_t *mt, moment_component_t u, int64_t v); 115 | moment_t THX_moment_with_offset_same_instant(pTHX_ const moment_t *mt, IV offset); 116 | moment_t THX_moment_with_offset_same_local(pTHX_ const moment_t *mt, IV offset); 117 | moment_t THX_moment_with_precision(pTHX_ const moment_t *mt, int64_t precision); 118 | 119 | moment_t THX_moment_plus_unit(pTHX_ const moment_t *mt, moment_unit_t u, int64_t v); 120 | moment_t THX_moment_minus_unit(pTHX_ const moment_t *mt, moment_unit_t u, int64_t v); 121 | 122 | int64_t THX_moment_delta_unit(pTHX_ const moment_t *mt1, const moment_t *mt2, moment_unit_t u); 123 | 124 | int64_t moment_instant_rd_seconds(const moment_t *mt); 125 | int64_t moment_local_rd_seconds(const moment_t *mt); 126 | 127 | dt_t moment_local_dt(const moment_t *mt); 128 | 129 | void moment_to_instant_rd_values(const moment_t *mt, IV *rdn, IV *sod, IV *nos); 130 | void moment_to_local_rd_values(const moment_t *mt, IV *rdn, IV *sod, IV *nos); 131 | 132 | int THX_moment_compare_precision(pTHX_ const moment_t *mt1, const moment_t *mt2, IV precision); 133 | int moment_compare_instant(const moment_t *m1, const moment_t *m2); 134 | int moment_compare_local(const moment_t *m1, const moment_t *m2); 135 | bool moment_equals(const moment_t *m1, const moment_t *m2); 136 | 137 | int moment_year(const moment_t *mt); 138 | int moment_quarter(const moment_t *mt); 139 | int moment_month(const moment_t *mt); 140 | int moment_week(const moment_t *mt); 141 | int moment_day_of_year(const moment_t *mt); 142 | int moment_day_of_quarter(const moment_t *mt); 143 | int moment_day_of_month(const moment_t *mt); 144 | int moment_day_of_week(const moment_t *mt); 145 | int moment_hour(const moment_t *mt); 146 | int moment_minute(const moment_t *mt); 147 | int moment_minute_of_day(const moment_t *mt); 148 | int moment_second(const moment_t *mt); 149 | int moment_second_of_day(const moment_t *mt); 150 | int moment_millisecond(const moment_t *mt); 151 | int moment_millisecond_of_day(const moment_t *mt); 152 | int moment_microsecond(const moment_t *mt); 153 | int64_t moment_microsecond_of_day(const moment_t *mt); 154 | int moment_nanosecond(const moment_t *mt); 155 | int64_t moment_nanosecond_of_day(const moment_t *mt); 156 | int moment_offset(const moment_t *mt); 157 | int64_t moment_epoch(const moment_t *mt); 158 | int moment_precision(const moment_t *mt); 159 | int moment_rata_die_day(const moment_t *mt); 160 | 161 | bool moment_is_leap_year(const moment_t *mt); 162 | 163 | NV moment_jd(const moment_t *mt); 164 | NV moment_mjd(const moment_t *mt); 165 | NV moment_rd(const moment_t *mt); 166 | 167 | int moment_length_of_year(const moment_t *mt); 168 | int moment_length_of_quarter(const moment_t *mt); 169 | int moment_length_of_month(const moment_t *mt); 170 | int moment_length_of_week_year(const moment_t *mt); 171 | 172 | moment_t THX_moment_at_utc(pTHX_ const moment_t *mt); 173 | moment_t THX_moment_at_midnight(pTHX_ const moment_t *mt); 174 | moment_t THX_moment_at_noon(pTHX_ const moment_t *mt); 175 | moment_t THX_moment_at_last_day_of_year(pTHX_ const moment_t *mt); 176 | moment_t THX_moment_at_last_day_of_quarter(pTHX_ const moment_t *mt); 177 | moment_t THX_moment_at_last_day_of_month(pTHX_ const moment_t *mt); 178 | 179 | 180 | int THX_moment_internal_western_easter(pTHX_ int64_t y); 181 | int THX_moment_internal_orthodox_easter(pTHX_ int64_t y); 182 | 183 | #define moment_new(Y, M, D, h, m, s, ns, offset) \ 184 | THX_moment_new(aTHX_ Y, M, D, h, m, s, ns, offset) 185 | 186 | #define moment_from_epoch(sec, nsec, offset) \ 187 | THX_moment_from_epoch(aTHX_ sec, nsec, offset) 188 | 189 | #define moment_from_epoch_nv(sec, precision) \ 190 | THX_moment_from_epoch_nv(aTHX_ sec, precision) 191 | 192 | #define moment_from_rd(rd, epoch, precision, offset) \ 193 | THX_moment_from_rd(aTHX_ rd, epoch, precision, offset) 194 | 195 | #define moment_from_jd(jd, epoch, precision) \ 196 | THX_moment_from_jd(aTHX_ jd, epoch, precision) 197 | 198 | #define moment_from_mjd(mjd, epoch, precision) \ 199 | THX_moment_from_mjd(aTHX_ mjd, epoch, precision) 200 | 201 | #define moment_with_offset_same_instant(self, offset) \ 202 | THX_moment_with_offset_same_instant(aTHX_ self, offset) 203 | 204 | #define moment_with_offset_same_local(self, offset) \ 205 | THX_moment_with_offset_same_local(aTHX_ self, offset) 206 | 207 | #define moment_with_precision(self, precision) \ 208 | THX_moment_with_precision(aTHX_ self, precision) 209 | 210 | #define moment_with_nanosecond(self, nsec) \ 211 | THX_moment_with_nanosecond(aTHX_ self, nsec) 212 | 213 | #define moment_plus_unit(self, unit, v) \ 214 | THX_moment_plus_unit(aTHX_ self, unit, v) 215 | 216 | #define moment_minus_unit(self, unit, v) \ 217 | THX_moment_minus_unit(aTHX_ self, unit, v) 218 | 219 | #define moment_delta_unit(self, other, unit) \ 220 | THX_moment_delta_unit(aTHX_ self, other, unit) 221 | 222 | #define moment_with_field(self, component, v) \ 223 | THX_moment_with_field(aTHX_ self, component, v) 224 | 225 | #define moment_at_utc(self) \ 226 | THX_moment_at_utc(aTHX_ self) 227 | 228 | #define moment_at_midnight(self) \ 229 | THX_moment_at_midnight(aTHX_ self) 230 | 231 | #define moment_at_noon(self) \ 232 | THX_moment_at_noon(aTHX_ self) 233 | 234 | #define moment_at_last_day_of_year(self) \ 235 | THX_moment_at_last_day_of_year(aTHX_ self) 236 | 237 | #define moment_at_last_day_of_quarter(self) \ 238 | THX_moment_at_last_day_of_quarter(aTHX_ self) 239 | 240 | #define moment_at_last_day_of_month(self) \ 241 | THX_moment_at_last_day_of_month(aTHX_ self) 242 | 243 | #define moment_compare_precision(mt1, mt2, precision) \ 244 | THX_moment_compare_precision(aTHX_ mt1, mt2, precision) 245 | 246 | /* Internal API but exposed in Perl */ 247 | 248 | #define moment_internal_western_easter(year) \ 249 | THX_moment_internal_western_easter(aTHX_ year) 250 | 251 | #define moment_internal_orthodox_easter(year) \ 252 | THX_moment_internal_orthodox_easter(aTHX_ year) 253 | 254 | #endif 255 | 256 | -------------------------------------------------------------------------------- /src/moment_fmt.h: -------------------------------------------------------------------------------- 1 | #ifndef __MOMENT_FMT_H__ 2 | #define __MOMENT_FMT_H__ 3 | #include "moment.h" 4 | 5 | SV * THX_moment_strftime(pTHX_ const moment_t *mt, const char *str, STRLEN len); 6 | SV * THX_moment_to_string(pTHX_ const moment_t *mt, bool reduced); 7 | 8 | #define moment_strftime(mt, str, len) \ 9 | THX_moment_strftime(aTHX_ mt, str, len) 10 | 11 | #define moment_to_string(mt, reduced) \ 12 | THX_moment_to_string(aTHX_ mt, reduced) 13 | 14 | #endif 15 | 16 | -------------------------------------------------------------------------------- /src/moment_parse.c: -------------------------------------------------------------------------------- 1 | #include "moment.h" 2 | #include "dt_core.h" 3 | #include "dt_parse_iso.h" 4 | 5 | static int 6 | parse_string_lenient(const char *str, size_t len, int64_t *sp, IV *np, IV *op) { 7 | size_t n; 8 | dt_t dt; 9 | char c; 10 | int sod, nanosecond, offset; 11 | 12 | n = dt_parse_iso_date(str, len, &dt); 13 | if (!n || n == len) 14 | return 1; 15 | 16 | c = str[n++]; 17 | if (!(c == 'T' || c == 't' || c == ' ')) 18 | return 1; 19 | 20 | str += n; 21 | len -= n; 22 | 23 | n = dt_parse_iso_time(str, len, &sod, &nanosecond); 24 | if (!n || n == len) 25 | return 1; 26 | 27 | if (str[n] == ' ') 28 | n++; 29 | 30 | str += n; 31 | len -= n; 32 | 33 | n = dt_parse_iso_zone_lenient(str, len, &offset); 34 | if (!n || n != len) 35 | return 1; 36 | 37 | *sp = ((int64_t)dt_rdn(dt) - 719163) * 86400 + sod - offset * 60; 38 | *np = nanosecond; 39 | *op = offset; 40 | return 0; 41 | } 42 | 43 | static int 44 | parse_string_strict(const char *str, size_t len, int64_t *sp, IV *np, IV *op) { 45 | size_t n; 46 | dt_t dt; 47 | int sod, nanosecond, offset; 48 | bool extended; 49 | 50 | n = dt_parse_iso_date(str, len, &dt); 51 | if (!n || n == len) 52 | return 1; 53 | 54 | /* 55 | * 0123456789 56 | * 2012-12-14 57 | */ 58 | extended = str[4] == '-'; 59 | if (str[n++] != 'T') 60 | return 1; 61 | 62 | str += n; 63 | len -= n; 64 | 65 | if (extended) 66 | n = dt_parse_iso_time_extended(str, len, &sod, &nanosecond); 67 | else 68 | n = dt_parse_iso_time_basic(str, len, &sod, &nanosecond); 69 | 70 | if (!n || n == len) 71 | return 1; 72 | 73 | str += n; 74 | len -= n; 75 | 76 | if (extended) 77 | n = dt_parse_iso_zone_extended(str, len, &offset); 78 | else 79 | n = dt_parse_iso_zone_basic(str, len, &offset); 80 | 81 | if (!n || n != len) 82 | return 1; 83 | 84 | *sp = ((int64_t)dt_rdn(dt) - 719163) * 86400 + sod - offset * 60; 85 | *np = nanosecond; 86 | *op = offset; 87 | return 0; 88 | } 89 | 90 | moment_t 91 | THX_moment_from_string(pTHX_ const char *str, STRLEN len, bool lenient) { 92 | int ret; 93 | int64_t seconds; 94 | IV nanosecond, offset; 95 | 96 | if (lenient) 97 | ret = parse_string_lenient(str, len, &seconds, &nanosecond, &offset); 98 | else 99 | ret = parse_string_strict(str, len, &seconds, &nanosecond, &offset); 100 | 101 | if (ret != 0) 102 | croak("Could not parse the given string"); 103 | 104 | return moment_from_epoch(seconds, nanosecond, offset); 105 | } 106 | 107 | -------------------------------------------------------------------------------- /src/moment_parse.h: -------------------------------------------------------------------------------- 1 | #ifndef __MOMENT_PARSE_H__ 2 | #define __MOMENT_PARSE_H__ 3 | #include "moment.h" 4 | 5 | moment_t THX_moment_from_string(pTHX_ const char *str, STRLEN len, bool lenient); 6 | 7 | #define moment_from_string(str, len, lenient) \ 8 | THX_moment_from_string(aTHX_ str, len, lenient) 9 | 10 | #endif 11 | 12 | -------------------------------------------------------------------------------- /t/000_load.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More tests => 1; 6 | use Config; 7 | 8 | BEGIN { 9 | use_ok('Time::Moment'); 10 | } 11 | 12 | my @has = qw(d_gettimeod d_localtime_r); 13 | foreach my $var (@has) { 14 | $var .= '=' . ($Config{$var} ? 'true' : 'false') 15 | } 16 | 17 | diag("Time::Moment $Time::Moment::VERSION, Perl $], $^X (@has)"); 18 | 19 | -------------------------------------------------------------------------------- /t/100_basic.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | my @tests = ( 12 | { 13 | day_of_month => 1, 14 | day_of_quarter => 1, 15 | day_of_week => 4, 16 | day_of_year => 1, 17 | epoch => 0, 18 | hour => 0, 19 | local_rd_as_seconds => 62135683200, 20 | nanosecond => 0, 21 | microsecond => 0, 22 | millisecond => 0, 23 | minute => 0, 24 | month => 1, 25 | offset => 0, 26 | quarter => 1, 27 | second => 0, 28 | strftime => { 29 | "a" => "Thu", 30 | "A" => "Thursday", 31 | "B" => "January", 32 | "b" => "Jan", 33 | "c" => "Thu Jan 1 00:00:00 1970", 34 | "C" => "19", 35 | "d" => "01", 36 | "D" => "01/01/70", 37 | "e" => " 1", 38 | "_e" => " 1", 39 | "-e" => "1", 40 | "0e" => "01", 41 | "f" => "", 42 | "0f" => "", 43 | "1f" => "", 44 | "2f" => "", 45 | "3f" => "", 46 | "6f" => "", 47 | "9f" => "", 48 | "F" => "1970-01-01", 49 | "g" => "70", 50 | "G" => "1970", 51 | "h" => "Jan", 52 | "H" => "00", 53 | "I" => "12", 54 | "j" => "001", 55 | "0j" => "001", 56 | "_j" => " 1", 57 | "-j" => "1", 58 | "k" => " 0", 59 | "l" => "12", 60 | "M" => "00", 61 | "m" => "01", 62 | "n" => "\n", 63 | "N" => "000", 64 | "0N" => "000", 65 | "3N" => "000", 66 | "6N" => "000000", 67 | "p" => "AM", 68 | "r" => "12:00:00 AM", 69 | "R" => "00:00", 70 | "s" => "0", 71 | "S" => "00", 72 | "T" => "00:00:00", 73 | "t" => "\t", 74 | "u" => "4", 75 | "U" => "00", 76 | "V" => "01", 77 | "w" => "4", 78 | "W" => "00", 79 | "x" => "01/01/70", 80 | "X" => "00:00:00", 81 | "Y" => "1970", 82 | "y" => "70", 83 | "z" => "+0000", 84 | ":z" => "+00:00", 85 | "Z" => "Z", 86 | }, 87 | string => "1970-01-01T00:00:00Z", 88 | to_string_reduced => "1970-01-01T00:00Z", 89 | utc_rd_as_seconds => 62135683200, 90 | week => 1, 91 | year => 1970, 92 | }, 93 | { 94 | day_of_month => 21, 95 | day_of_quarter => 82, 96 | day_of_week => 6, 97 | day_of_year => 355, 98 | epoch => 1387615694, 99 | hour => 13, 100 | local_rd_as_seconds => 63523314014, 101 | nanosecond => 426347000, 102 | microsecond => 426347, 103 | millisecond => 426, 104 | minute => 0, 105 | month => 12, 106 | offset => 252, 107 | quarter => 4, 108 | second => 14, 109 | strftime => { 110 | "a" => "Sat", 111 | "A" => "Saturday", 112 | "B" => "December", 113 | "b" => "Dec", 114 | "c" => "Sat Dec 21 13:00:14 2013", 115 | "C" => "20", 116 | "d" => "21", 117 | "D" => "12/21/13", 118 | "e" => "21", 119 | "f" => ".426347", 120 | "0f" => ".426347", 121 | "3f" => ".426", 122 | "4f" => ".4263", 123 | "5f" => ".42634", 124 | "6f" => ".426347", 125 | "9f" => ".426347000", 126 | "F" => "2013-12-21", 127 | "g" => "13", 128 | "G" => "2013", 129 | "h" => "Dec", 130 | "H" => "13", 131 | "I" => "01", 132 | "k" => "13", 133 | "l" => " 1", 134 | "j" => "355", 135 | "M" => "00", 136 | "m" => "12", 137 | "n" => "\n", 138 | "N" => "426347", 139 | "0N" => "426347", 140 | "3N" => "426", 141 | "6N" => "426347", 142 | "p" => "PM", 143 | "r" => "01:00:14 PM", 144 | "R" => "13:00", 145 | "s" => "1387615694", 146 | "S" => "14", 147 | "T" => "13:00:14", 148 | "t" => "\t", 149 | "u" => "6", 150 | "U" => "50", 151 | "V" => "51", 152 | "w" => "6", 153 | "W" => "50", 154 | "x" => "12/21/13", 155 | "X" => "13:00:14", 156 | "Y" => "2013", 157 | "y" => "13", 158 | "z" => "+0412", 159 | ":z" => "+04:12", 160 | "Z" => "+04:12", 161 | }, 162 | string => "2013-12-21T13:00:14.426347+04:12", 163 | to_string_reduced => "2013-12-21T13:00:14.426347+04:12", 164 | utc_rd_as_seconds => 63523298894, 165 | week => 51, 166 | year => 2013, 167 | }, 168 | { 169 | day_of_month => 4, 170 | day_of_quarter => 66, 171 | day_of_week => 5, 172 | day_of_year => 247, 173 | epoch => 4092260337, 174 | hour => 12, 175 | local_rd_as_seconds => 66227893137, 176 | nanosecond => 91592000, 177 | microsecond => 91592, 178 | millisecond => 91, 179 | minute => 58, 180 | month => 9, 181 | offset => -840, 182 | quarter => 3, 183 | second => 57, 184 | strftime => { 185 | "a" => "Fri", 186 | "A" => "Friday", 187 | "B" => "September", 188 | "b" => "Sep", 189 | "c" => "Fri Sep 4 12:58:57 2099", 190 | "C" => "20", 191 | "d" => "04", 192 | "D" => "09/04/99", 193 | "e" => " 4", 194 | "f" => ".091592", 195 | "0f" => ".091592", 196 | "3f" => ".091", 197 | "F" => "2099-09-04", 198 | "g" => "99", 199 | "G" => "2099", 200 | "h" => "Sep", 201 | "H" => "12", 202 | "I" => "12", 203 | "j" => "247", 204 | "k" => "12", 205 | "l" => "12", 206 | "M" => "58", 207 | "m" => "09", 208 | "n" => "\n", 209 | "N" => "091592", 210 | "0N" => "091592", 211 | "3N" => "091", 212 | "6N" => "091592", 213 | "p" => "PM", 214 | "r" => "12:58:57 PM", 215 | "R" => "12:58", 216 | "s" => "4092260337", 217 | "S" => "57", 218 | "T" => "12:58:57", 219 | "t" => "\t", 220 | "u" => "5", 221 | "U" => "35", 222 | "V" => "36", 223 | "w" => "5", 224 | "W" => "35", 225 | "x" => "09/04/99", 226 | "X" => "12:58:57", 227 | "Y" => "2099", 228 | "y" => "99", 229 | ":z" => "-14:00", 230 | "Z" => "-14:00", 231 | }, 232 | string => "2099-09-04T12:58:57.091592-14:00", 233 | to_string_reduced => "2099-09-04T12:58:57.091592-14", 234 | utc_rd_as_seconds => 66227943537, 235 | week => 36, 236 | year => 2099, 237 | }, 238 | ); 239 | 240 | my @Accessors = qw( 241 | year quarter month week day_of_year day_of_quarter day_of_month day_of_week 242 | hour minute second millisecond microsecond 243 | epoch offset utc_rd_as_seconds local_rd_as_seconds 244 | ); 245 | 246 | foreach my $test (@tests) { 247 | my $name = $test->{string}; 248 | 249 | my $tm = Time::Moment->from_epoch(@$test{qw(epoch nanosecond)}) 250 | ->with_offset($test->{offset}); 251 | 252 | foreach my $accessor (@Accessors) { 253 | is($tm->$accessor, $test->{$accessor}, "${name} ->${accessor}"); 254 | } 255 | my $strftime = $test->{strftime}; 256 | foreach my $spec (sort keys %{$strftime}) { 257 | is($tm->strftime("%${spec}"), $strftime->{$spec}, "${name} strftime('%${spec}')"); 258 | } 259 | 260 | is($tm, $test->{string}, "{$name} expected stringified representation"); 261 | is($tm->to_string, $test->{string}, "{$name} ->to_string representation"); 262 | is($tm->to_string(reduced => 1), $test->{to_string_reduced}, "{$name} ->to_string(reduced => 1) representation"); 263 | } 264 | 265 | done_testing(); 266 | 267 | 268 | -------------------------------------------------------------------------------- /t/110_now.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Util qw[throws_ok lives_ok]; 8 | 9 | BEGIN { 10 | use_ok('Time::Moment'); 11 | } 12 | 13 | { 14 | my $tm; 15 | lives_ok { $tm = Time::Moment->now }; 16 | isa_ok($tm, 'Time::Moment'); 17 | cmp_ok($tm->epoch, '>', 0, "epoch"); 18 | 19 | my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) 20 | = localtime($tm->epoch); 21 | 22 | $year += 1900; 23 | $yday += 1; 24 | $mon += 1; 25 | $wday = 1 + ($wday + 6) % 7; 26 | 27 | is($tm->year, $year, '->year'); 28 | is($tm->month, $mon, '->month'); 29 | is($tm->day_of_year, $yday, '->day_of_year'); 30 | is($tm->day_of_month, $mday, '->day_of_month'); 31 | is($tm->day_of_week, $wday, '->day_of_week'); 32 | is($tm->hour, $hour, '->hour'); 33 | is($tm->minute, $min, '->minute'); 34 | is($tm->second, $sec, '->second'); 35 | } 36 | 37 | done_testing(); 38 | 39 | -------------------------------------------------------------------------------- /t/120_now_utc.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Util qw[throws_ok lives_ok]; 8 | 9 | BEGIN { 10 | use_ok('Time::Moment'); 11 | } 12 | 13 | { 14 | my $tm; 15 | lives_ok { $tm = Time::Moment->now_utc }; 16 | isa_ok($tm, 'Time::Moment'); 17 | cmp_ok($tm->epoch, '>', 0, "epoch"); 18 | cmp_ok($tm->offset, '==', 0, "offset"); 19 | 20 | my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) 21 | = gmtime($tm->epoch); 22 | 23 | $year += 1900; 24 | $yday += 1; 25 | $mon += 1; 26 | $wday = 1 + ($wday + 6) % 7; 27 | 28 | is($tm->year, $year, '->year'); 29 | is($tm->month, $mon, '->month'); 30 | is($tm->day_of_year, $yday, '->day_of_year'); 31 | is($tm->day_of_month, $mday, '->day_of_month'); 32 | is($tm->day_of_week, $wday, '->day_of_week'); 33 | is($tm->hour, $hour, '->hour'); 34 | is($tm->minute, $min, '->minute'); 35 | is($tm->second, $sec, '->second'); 36 | } 37 | 38 | done_testing(); 39 | 40 | -------------------------------------------------------------------------------- /t/140_from_object.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Util qw[throws_ok lives_ok]; 8 | 9 | BEGIN { 10 | use_ok('Time::Moment'); 11 | } 12 | 13 | { 14 | package MyFoo; 15 | 16 | sub new { 17 | my ($class, %p) = @_; 18 | return bless \%p, $class; 19 | } 20 | 21 | sub epoch { return $_[0]->{epoch} } 22 | 23 | sub __as_Time_Moment { 24 | my ($self) = @_; 25 | return Time::Moment->from_epoch($self->epoch); 26 | } 27 | } 28 | 29 | { 30 | package MyBar; 31 | 32 | sub new { 33 | my ($class, %p) = @_; 34 | return bless \%p, $class; 35 | } 36 | } 37 | 38 | { 39 | my $mf = MyFoo->new(epoch => 123456789); 40 | my $tm; 41 | 42 | lives_ok { $tm = Time::Moment->from_object($mf) }; 43 | isa_ok($tm, 'Time::Moment'); 44 | is($tm->epoch, 123456789, '->epoch'); 45 | is($tm->offset, 0, '->offset'); 46 | } 47 | 48 | { 49 | my $mb = MyBar->new(epoch => 123456789); 50 | throws_ok { Time::Moment->from_object($mb) } q/^Cannot coerce object of type MyBar/; 51 | } 52 | 53 | done_testing(); 54 | 55 | -------------------------------------------------------------------------------- /t/145_from_object_tp.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires qw[Time::Piece]; 8 | use Util qw[lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my $tp = Time::Piece::gmtime(123456789); 16 | my $tm; 17 | 18 | lives_ok { $tm = Time::Moment->from_object($tp) }; 19 | isa_ok($tm, 'Time::Moment'); 20 | is($tm->epoch, 123456789, '->epoch'); 21 | is($tm->offset, 0, '->offset'); 22 | } 23 | 24 | { 25 | my $tp = Time::Piece::localtime(123456789); 26 | my $tm; 27 | 28 | lives_ok { $tm = Time::Moment->from_object($tp) }; 29 | isa_ok($tm, 'Time::Moment'); 30 | is($tm->epoch, 123456789, '->epoch'); 31 | is($tm->year, $tp->year, '->year'); 32 | is($tm->month, $tp->mon, '->month'); 33 | is($tm->day_of_month, $tp->day_of_month, '->day_of_month'); 34 | is($tm->hour, $tp->hour, '->hour'); 35 | is($tm->minute, $tp->minute, '->minute'); 36 | is($tm->second, $tp->second, '->second'); 37 | } 38 | 39 | done_testing(); 40 | 41 | -------------------------------------------------------------------------------- /t/150_from_object_dt.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires qw[DateTime]; 8 | use Util qw[throws_ok lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my $dt = DateTime->from_epoch(epoch => 123456789); 16 | my $tm; 17 | 18 | lives_ok { $tm = Time::Moment->from_object($dt) }; 19 | isa_ok($tm, 'Time::Moment'); 20 | is($tm->epoch, 123456789, '->epoch'); 21 | is($tm->offset, 0, '->offset'); 22 | } 23 | 24 | { 25 | my $dt = DateTime->from_epoch(epoch => 123456789, time_zone => '+02:00'); 26 | my $tm; 27 | 28 | lives_ok { $tm = Time::Moment->from_object($dt) }; 29 | isa_ok($tm, 'Time::Moment'); 30 | is($tm->epoch, 123456789, '->epoch'); 31 | is($tm->offset, 2*60, '->offset'); 32 | is($tm->year, $dt->year, '->year'); 33 | is($tm->month, $dt->month, '->month'); 34 | is($tm->day_of_month, $dt->day_of_month, '->day_of_month'); 35 | is($tm->hour, $dt->hour, '->hour'); 36 | is($tm->minute, $dt->minute, '->minute'); 37 | is($tm->second, $dt->second, '->second'); 38 | } 39 | 40 | { 41 | my $dt = DateTime->new(year => 2012); 42 | throws_ok { Time::Moment->from_object($dt) } qr/^Cannot coerce .* 'floating'/; 43 | } 44 | 45 | done_testing(); 46 | 47 | -------------------------------------------------------------------------------- /t/180_from_string.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Util qw[throws_ok lives_ok]; 8 | 9 | BEGIN { 10 | use_ok('Time::Moment'); 11 | } 12 | 13 | sub TRUE () { !!1 } 14 | 15 | { 16 | my @tests = ( 17 | [ '0001-01-01T00:00:00Z', -62135596800, 0, 0 ], 18 | [ '00010101T000000Z', -62135596800, 0, 0 ], 19 | [ '0001-W01-1T00:00:00Z', -62135596800, 0, 0 ], 20 | [ '0001W011T000000Z', -62135596800, 0, 0 ], 21 | [ '0001-001T00:00:00Z', -62135596800, 0, 0 ], 22 | [ '0001001T000000Z', -62135596800, 0, 0 ], 23 | [ '1970-01-01T00:00:00Z', 0, 0, 0 ], 24 | [ '1970-01-01T02:00:00+02:00', 0, 0, 120 ], 25 | [ '1970-01-01T01:30:00+01:30', 0, 0, 90 ], 26 | [ '1970-01-01T01:00:00+01:00', 0, 0, 60 ], 27 | [ '1970-01-01T00:01:00+00:01', 0, 0, 1 ], 28 | [ '1970-01-01T00:00:00+00:00', 0, 0, 0 ], 29 | [ '1969-12-31T23:59:00-00:01', 0, 0, -1 ], 30 | [ '1969-12-31T23:00:00-01:00', 0, 0, -60 ], 31 | [ '1969-12-31T22:30:00-01:30', 0, 0, -90 ], 32 | [ '1969-12-31T22:00:00-02:00', 0, 0, -120 ], 33 | [ '1970-01-01T00:00:00.123456789Z', 0, 123456789, 0 ], 34 | [ '1970-01-01T00:00:00.12345678Z', 0, 123456780, 0 ], 35 | [ '1970-01-01T00:00:00.1234567Z', 0, 123456700, 0 ], 36 | [ '1970-01-01T00:00:00.123456Z', 0, 123456000, 0 ], 37 | [ '1970-01-01T00:00:00.12345Z', 0, 123450000, 0 ], 38 | [ '1970-01-01T00:00:00.1234Z', 0, 123400000, 0 ], 39 | [ '1970-01-01T00:00:00.123Z', 0, 123000000, 0 ], 40 | [ '1970-01-01T00:00:00.12Z', 0, 120000000, 0 ], 41 | [ '1970-01-01T00:00:00.1Z', 0, 100000000, 0 ], 42 | [ '1970-01-01T00:00:00.01Z', 0, 10000000, 0 ], 43 | [ '1970-01-01T00:00:00.001Z', 0, 1000000, 0 ], 44 | [ '1970-01-01T00:00:00.0001Z', 0, 100000, 0 ], 45 | [ '1970-01-01T00:00:00.00001Z', 0, 10000, 0 ], 46 | [ '1970-01-01T00:00:00.000001Z', 0, 1000, 0 ], 47 | [ '1970-01-01T00:00:00.0000001Z', 0, 100, 0 ], 48 | [ '1970-01-01T00:00:00.00000001Z', 0, 10, 0 ], 49 | [ '1970-01-01T00:00:00.000000001Z', 0, 1, 0 ], 50 | [ '1970-01-01T00:00:00.000000009Z', 0, 9, 0 ], 51 | [ '1970-01-01T00:00:00.00000009Z', 0, 90, 0 ], 52 | [ '1970-01-01T00:00:00.0000009Z', 0, 900, 0 ], 53 | [ '1970-01-01T00:00:00.000009Z', 0, 9000, 0 ], 54 | [ '1970-01-01T00:00:00.00009Z', 0, 90000, 0 ], 55 | [ '1970-01-01T00:00:00.0009Z', 0, 900000, 0 ], 56 | [ '1970-01-01T00:00:00.009Z', 0, 9000000, 0 ], 57 | [ '1970-01-01T00:00:00.09Z', 0, 90000000, 0 ], 58 | [ '1970-01-01T00:00:00.9Z', 0, 900000000, 0 ], 59 | [ '1970-01-01T00:00:00.99Z', 0, 990000000, 0 ], 60 | [ '1970-01-01T00:00:00.999Z', 0, 999000000, 0 ], 61 | [ '1970-01-01T00:00:00.9999Z', 0, 999900000, 0 ], 62 | [ '1970-01-01T00:00:00.99999Z', 0, 999990000, 0 ], 63 | [ '1970-01-01T00:00:00.999999Z', 0, 999999000, 0 ], 64 | [ '1970-01-01T00:00:00.9999999Z', 0, 999999900, 0 ], 65 | [ '1970-01-01T00:00:00.99999999Z', 0, 999999990, 0 ], 66 | [ '1970-01-01T00:00:00.999999999Z', 0, 999999999, 0 ], 67 | [ '1970-01-01T00:00:00.0Z', 0, 0, 0 ], 68 | [ '1970-01-01T00:00:00.00Z', 0, 0, 0 ], 69 | [ '1970-01-01T00:00:00.000Z', 0, 0, 0 ], 70 | [ '1970-01-01T00:00:00.0000Z', 0, 0, 0 ], 71 | [ '1970-01-01T00:00:00.00000Z', 0, 0, 0 ], 72 | [ '1970-01-01T00:00:00.000000Z', 0, 0, 0 ], 73 | [ '1970-01-01T00:00:00.0000000Z', 0, 0, 0 ], 74 | [ '1970-01-01T00:00:00.00000000Z', 0, 0, 0 ], 75 | [ '1970-01-01T00:00:00.000000000Z', 0, 0, 0 ], 76 | [ '1973-11-29T21:33:09Z', 123456789, 0, 0 ], 77 | [ '2013-10-28T17:51:56Z', 1382982716, 0, 0 ], 78 | [ '9999-12-31T23:59:59Z', 253402300799, 0, 0 ], 79 | ); 80 | 81 | foreach my $test (@tests) { 82 | my ($string, $epoch, $nanosecond, $offset) = @$test; 83 | 84 | my $tm = Time::Moment->from_string($string); 85 | is($tm->epoch, $epoch, "${string} epoch"); 86 | is($tm->nanosecond, $nanosecond, "${string} nanosecond"); 87 | is($tm->offset, $offset, "${string} offset"); 88 | } 89 | } 90 | 91 | { 92 | my $exp = Time::Moment->from_string('2012-12-24T15:30Z'); 93 | my @tests = ( 94 | '2012-12-24 15:30Z', 95 | '2012-12-24 15:30z', 96 | '2012-12-24 16:30+01:00', 97 | '2012-12-24 16:30+0100', 98 | '2012-12-24 16:30+01', 99 | '2012-12-24 14:30-01:00', 100 | '2012-12-24 14:30-0100', 101 | '2012-12-24 14:30-01', 102 | '2012-12-24 15:30:00Z', 103 | '2012-12-24 15:30:00z', 104 | '2012-12-24 16:30:00+01:00', 105 | '2012-12-24 16:30:00+0100', 106 | '2012-12-24 14:30:00-01:00', 107 | '2012-12-24 14:30:00-0100', 108 | '2012-12-24 15:30:00.123456Z', 109 | '2012-12-24 15:30:00.123456z', 110 | '2012-12-24 16:30:00.123456+01:00', 111 | '2012-12-24 16:30:00.123456+01', 112 | '2012-12-24 14:30:00.123456-01:00', 113 | '2012-12-24 14:30:00.123456-01', 114 | '2012-12-24t15:30Z', 115 | '2012-12-24t15:30z', 116 | '2012-12-24t16:30+01:00', 117 | '2012-12-24t16:30+0100', 118 | '2012-12-24t14:30-01:00', 119 | '2012-12-24t14:30-0100', 120 | '2012-12-24t15:30:00Z', 121 | '2012-12-24t15:30:00z', 122 | '2012-12-24t16:30:00+01:00', 123 | '2012-12-24t16:30:00+0100', 124 | '2012-12-24t14:30:00-01:00', 125 | '2012-12-24t14:30:00-0100', 126 | '2012-12-24t15:30:00.123456Z', 127 | '2012-12-24t15:30:00.123456z', 128 | '2012-12-24t16:30:00.123456+01:00', 129 | '2012-12-24t14:30:00.123456-01:00', 130 | '2012-12-24 16:30 +01:00', 131 | '2012-12-24 14:30 -01:00', 132 | '2012-12-24 15:30 UTC', 133 | '2012-12-24 16:30 UTC+1', 134 | '2012-12-24 16:30 UTC+01', 135 | '2012-12-24 16:30 UTC+0100', 136 | '2012-12-24 16:30 UTC+01:00', 137 | '2012-12-24 14:30 UTC-1', 138 | '2012-12-24 14:30 UTC-01', 139 | '2012-12-24 14:30 UTC-01:00', 140 | '2012-12-24 14:30 UTC-0100', 141 | '2012-12-24 15:30 GMT', 142 | '2012-12-24 16:30 GMT+1', 143 | '2012-12-24 16:30 GMT+01', 144 | '2012-12-24 16:30 GMT+0100', 145 | '2012-12-24 16:30 GMT+01:00', 146 | '2012-12-24 14:30 GMT-1', 147 | '2012-12-24 14:30 GMT-01', 148 | '2012-12-24 14:30 GMT-01:00', 149 | '2012-12-24 14:30 GMT-0100', 150 | '2012-12-24 14:30 -01:00', 151 | '2012-12-24 16:30:00 +01:00', 152 | '2012-12-24 14:30:00 -01:00', 153 | '2012-12-24 16:30:00.123456 +01:00', 154 | '2012-12-24 14:30:00.123456 -01:00', 155 | '2012-12-24 15:30:00.123456 -00:00', 156 | '20121224T1630+01:00', 157 | '2012-12-24T1630+01:00', 158 | '20121224T16:30+01', 159 | '20121224T16:30 +01', 160 | ); 161 | 162 | foreach my $string (@tests) { 163 | { 164 | my $name = "from_string($string)"; 165 | throws_ok { Time::Moment->from_string($string) } q/^Could not parse/, $name; 166 | } 167 | { 168 | my $tm; 169 | my $name = "->from_string($string, lenient => TRUE)"; 170 | lives_ok { 171 | $tm = Time::Moment->from_string($string, lenient => TRUE); 172 | } $name; 173 | is($tm->epoch, $exp->epoch, "$name->epoch"); 174 | } 175 | } 176 | } 177 | 178 | done_testing(); 179 | 180 | -------------------------------------------------------------------------------- /t/200_compare.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my $tm1 = Time::Moment->from_epoch(0); 13 | my $tm2 = Time::Moment->from_epoch(86400); 14 | 15 | is($tm1->is_before($tm2), !!1, "$tm1 is before $tm2"); 16 | is($tm1->is_after($tm2), !!0, "$tm1 is not after $tm2"); 17 | is($tm1->is_equal($tm2), !!0, "$tm1 is not equal $tm2"); 18 | 19 | is($tm2->is_before($tm1), !!0, "$tm2 is not before $tm1"); 20 | is($tm2->is_after($tm1), !!1, "$tm2 is after $tm1"); 21 | is($tm2->is_equal($tm1), !!0, "$tm2 is not equal $tm1"); 22 | 23 | is($tm1->is_equal($tm1), !!1, "$tm1 is equal $tm1"); 24 | is($tm2->is_equal($tm2), !!1, "$tm2 is equal $tm2"); 25 | 26 | cmp_ok($tm1->compare($tm2), '<', 0, "$tm1 ->compare $tm2"); 27 | cmp_ok($tm2->compare($tm1), '>', 0, "$tm2 ->compare $tm1"); 28 | cmp_ok($tm1->compare($tm1), '==', 0, "$tm1 ->compare $tm1"); 29 | cmp_ok($tm2->compare($tm2), '==', 0, "$tm2 ->compare $tm2"); 30 | 31 | cmp_ok($tm1, '!=', $tm2, "$tm1 != $tm2"); 32 | cmp_ok($tm1, '<', $tm2, "$tm1 < $tm2"); 33 | cmp_ok($tm1, '<=', $tm2, "$tm1 <= $tm2"); 34 | cmp_ok($tm1, '==', $tm1, "$tm1 == $tm1"); 35 | 36 | cmp_ok($tm2, '!=', $tm1, "$tm2 != $tm1"); 37 | cmp_ok($tm2, '>', $tm1, "$tm2 > $tm1"); 38 | cmp_ok($tm2, '>=', $tm1, "$tm2 >= $tm1"); 39 | cmp_ok($tm2, '==', $tm2, "$tm2 == $tm2"); 40 | 41 | my $s1 = '1970-01-01T00:00:00Z'; 42 | my $s2 = '1970-01-02T00:00:00Z'; 43 | cmp_ok($tm2, 'ne', $s1, "$tm2 ne $s1"); 44 | cmp_ok($tm2, 'gt', $s1, "$tm2 gt $s1"); 45 | cmp_ok($tm2, 'ge', $s1, "$tm2 ge $s1"); 46 | cmp_ok($tm2, 'eq', $s2, "$tm2 eq $s2"); 47 | } 48 | 49 | done_testing(); 50 | 51 | -------------------------------------------------------------------------------- /t/300_strftime.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my @tests = ( 13 | # Combinations of calendar date and time of day 14 | [ '%Y%m%dT%H%M%S%z', '20121224T153045+0100' ], 15 | [ '%Y%m%dT%H%M%S%f%z', '20121224T153045.500+0100' ], 16 | [ '%Y%m%dT%H%M%z', '20121224T1530+0100' ], 17 | [ '%Y-%m-%dT%H:%M:%S%Z', '2012-12-24T15:30:45+01:00' ], 18 | [ '%Y-%m-%dT%H:%M:%S%f%Z', '2012-12-24T15:30:45.500+01:00' ], 19 | [ '%Y-%m-%dT%H:%M%Z', '2012-12-24T15:30+01:00' ], 20 | 21 | # Combinations of ordinal date and time of day 22 | [ '%Y%jT%H%M%S%z', '2012359T153045+0100' ], 23 | [ '%Y%jT%H%M%S%f%z', '2012359T153045.500+0100' ], 24 | [ '%Y%jT%H%M%z', '2012359T1530+0100' ], 25 | [ '%Y-%jT%H:%M:%S%Z', '2012-359T15:30:45+01:00', ], 26 | [ '%Y-%jT%H:%M:%S%f%Z', '2012-359T15:30:45.500+01:00' ], 27 | [ '%Y-%jT%H:%M%Z', '2012-359T15:30+01:00' ], 28 | 29 | # Combinations of week date and time of day 30 | [ '%GW%V%uT%H%M%S%z', '2012W521T153045+0100' ], 31 | [ '%GW%V%uT%H%M%S%f%z', '2012W521T153045.500+0100' ], 32 | [ '%GW%V%uT%H%M%f%z', '2012W521T1530+0100' ], 33 | [ '%G-W%V-%uT%H:%M:%S%Z', '2012-W52-1T15:30:45+01:00' ], 34 | [ '%G-W%V-%uT%H:%M:%S%f%Z', '2012-W52-1T15:30:45.500+01:00' ], 35 | [ '%G-W%V-%uT%H:%M%Z', '2012-W52-1T15:30+01:00' ], 36 | ); 37 | 38 | foreach my $test (@tests) { 39 | my ($format, $string) = @$test; 40 | my $tm = Time::Moment->from_string($string); 41 | is($tm->strftime($format), $string, "$string '$format'"); 42 | } 43 | } 44 | 45 | { 46 | my $string = '0001-01-01T01:01:01Z'; 47 | my $tm = Time::Moment->from_string($string); 48 | my @single = ( 49 | # Years 50 | [ '0001', [ qw( Y 0Y G 0G ) ] ], 51 | [ ' 1', [ qw( _Y _G ) ] ], 52 | [ '1', [ qw( -Y -G ) ] ], 53 | [ '01', [ qw( y 0y g 0g ) ] ], 54 | [ ' 1', [ qw( _y _g ) ] ], 55 | [ '1', [ qw( -y -g ) ] ], 56 | 57 | [ '00', [ qw( C 0C ) ] ], 58 | [ ' 0', [ qw( _C ) ] ], 59 | [ '0', [ qw( -C ) ] ], 60 | 61 | # Month of year 62 | [ '01', [ qw( m 0m ) ] ], 63 | [ ' 1', [ qw( _m ) ] ], 64 | [ '1', [ qw( -m ) ] ], 65 | 66 | # Week numbers 67 | [ '01', [ qw( V 0V W 0W ) ] ], 68 | [ ' 1', [ qw( _V _W ) ] ], 69 | [ '1', [ qw( -V -W ) ] ], 70 | [ '00', [ qw( U 0U ) ] ], 71 | [ ' 0', [ qw( _U ) ] ], 72 | [ '0', [ qw( -U ) ] ], 73 | 74 | # Day of month 75 | [ '01', [ qw( d 0d 0e ) ] ], 76 | [ ' 1', [ qw( _d e _e ) ] ], 77 | [ '1', [ qw( -d -e ) ] ], 78 | 79 | # Day of year 80 | [ '001', [ qw( j 0j ) ] ], 81 | [ ' 1', [ qw( _j ) ] ], 82 | [ '1', [ qw( -j ) ] ], 83 | 84 | # Day of week 85 | [ '1', [ qw( u w ) ] ], 86 | 87 | # Time components 88 | [ '01', [ qw( H 0H M 0M S 0S 0k ) ] ], 89 | [ ' 1', [ qw( _H _M _S _k ) ] ], 90 | [ '1', [ qw( -H -M -S -k ) ] ], 91 | [ '01', [ qw( I 0I 0l ) ] ], 92 | [ ' 1', [ qw( l _l _I ) ] ], 93 | [ '1', [ qw( -l -I ) ] ], 94 | ); 95 | 96 | foreach my $test (@single) { 97 | my ($exp, @specifiers) = ($test->[0], @{$test->[1]}); 98 | foreach my $specifier (@specifiers) { 99 | is($tm->strftime("%${specifier}"), $exp, "$string '%${specifier}'"); 100 | } 101 | } 102 | 103 | my @combined = ( 104 | [ 'c', 'Mon Jan 1 01:01:01 0001' ], 105 | [ 'D', '01/01/01' ], 106 | [ 'F', '0001-01-01' ], 107 | [ 'r', '01:01:01 AM' ], 108 | [ 'R', '01:01' ], 109 | [ 'T', '01:01:01' ], 110 | [ 'X', '01:01:01' ], 111 | [ 'x', '01/01/01' ], 112 | ); 113 | 114 | foreach my $test (@combined) { 115 | my ($specifier, $exp) = @$test; 116 | is($tm->strftime("%${specifier}"), $exp, "$string '%${specifier}'"); 117 | } 118 | } 119 | 120 | { 121 | my $string = '9999-12-31T23:59:59Z'; 122 | my $tm = Time::Moment->from_string($string); 123 | my @single = ( 124 | # Years 125 | [ '9999', [ qw( Y 0Y G 0G ) ] ], 126 | [ '9999', [ qw( _Y _G ) ] ], 127 | [ '9999', [ qw( -Y -G ) ] ], 128 | [ '99', [ qw( y 0y g 0g ) ] ], 129 | [ '99', [ qw( _y _g ) ] ], 130 | [ '99', [ qw( -y -g ) ] ], 131 | 132 | [ '99', [ qw( C 0C _C -C ) ] ], 133 | 134 | # Month of year 135 | [ '12', [ qw( m 0m _m -m ) ] ], 136 | 137 | # Week numbers 138 | [ '52', [ qw( V 0V W 0W U 0U ) ] ], 139 | [ '52', [ qw( _V _W _U ) ] ], 140 | [ '52', [ qw( -V -W -U ) ] ], 141 | 142 | # Day of month 143 | [ '31', [ qw( d 0d _d -d e 0e _e -e ) ] ], 144 | 145 | # Day of year 146 | [ '365', [ qw( j 0j _j -j ) ] ], 147 | 148 | # Day of week 149 | [ '5', [ qw( u w ) ] ], 150 | 151 | # Time components 152 | [ '23', [ qw( H 0H _H -H k 0k _k -k ) ] ], 153 | [ '59', [ qw( M 0M S 0S ) ] ], 154 | [ '59', [ qw( _M _S ) ] ], 155 | [ '59', [ qw( -M -S ) ] ], 156 | [ '11', [ qw( I 0I 0l ) ] ], 157 | [ '11', [ qw( l _l _I ) ] ], 158 | [ '11', [ qw( -l -I ) ] ], 159 | ); 160 | 161 | foreach my $test (@single) { 162 | my ($exp, @specifiers) = ($test->[0], @{$test->[1]}); 163 | foreach my $specifier (@specifiers) { 164 | is($tm->strftime("%${specifier}"), $exp, "$string '%${specifier}'"); 165 | } 166 | } 167 | 168 | my @combined = ( 169 | [ 'c', 'Fri Dec 31 23:59:59 9999' ], 170 | [ 'D', '12/31/99' ], 171 | [ 'F', '9999-12-31' ], 172 | [ 'r', '11:59:59 PM' ], 173 | [ 'R', '23:59' ], 174 | [ 'T', '23:59:59' ], 175 | [ 'X', '23:59:59' ], 176 | [ 'x', '12/31/99' ], 177 | ); 178 | 179 | foreach my $test (@combined) { 180 | my ($specifier, $exp) = @$test; 181 | is($tm->strftime("%${specifier}"), $exp, "$string '%${specifier}'"); 182 | } 183 | } 184 | 185 | { 186 | my @times = map { 187 | Time::Moment->new(year => 1, month => 1, day => $_) 188 | } (1..7); 189 | 190 | my @DayShort = qw( 191 | Mon 192 | Tue 193 | Wed 194 | Thu 195 | Fri 196 | Sat 197 | Sun 198 | ); 199 | 200 | my @DayFull = qw( 201 | Monday 202 | Tuesday 203 | Wednesday 204 | Thursday 205 | Friday 206 | Saturday 207 | Sunday 208 | ); 209 | 210 | for (my $i = 0; $i < @times; $i++) { 211 | my $tm = $times[$i]; 212 | is($tm->strftime('%a'), $DayShort[$i], "$tm '%a'"); 213 | is($tm->strftime('%A'), $DayFull[$i], "$tm '%A'"); 214 | } 215 | } 216 | 217 | { 218 | my @times = map { 219 | Time::Moment->new(year => 1, month => $_, day => 1) 220 | } (1..12); 221 | 222 | my @MonthShort = qw( 223 | Jan 224 | Feb 225 | Mar 226 | Apr 227 | May 228 | Jun 229 | Jul 230 | Aug 231 | Sep 232 | Oct 233 | Nov 234 | Dec 235 | ); 236 | 237 | my @MonthFull = qw( 238 | January 239 | February 240 | March 241 | April 242 | May 243 | June 244 | July 245 | August 246 | September 247 | October 248 | November 249 | December 250 | ); 251 | 252 | for (my $i = 0; $i < @times; $i++) { 253 | my $tm = $times[$i]; 254 | is($tm->strftime('%h'), $MonthShort[$i], "$tm '%h'"); 255 | is($tm->strftime('%b'), $MonthShort[$i], "$tm '%b'"); 256 | is($tm->strftime('%B'), $MonthFull[$i], "$tm '%B'"); 257 | } 258 | } 259 | 260 | { 261 | my @hours = (0, 3, 6, 9, 12, 15, 17); 262 | my @minutes = (0, 1, 15, 30, 45, 59); 263 | my @sign = qw(- +); 264 | 265 | foreach my $h (@hours) { 266 | foreach my $m (@minutes) { 267 | my $n = $h * 60 + $m; 268 | foreach my $off ($n == 0 ? ($n) : ($n, -$n)) { 269 | my $tm = Time::Moment->new(year => 2000, offset => $off); 270 | my $exp; 271 | 272 | $exp = sprintf '%s%02d%02d', $sign[$off >= 0], $h, $m; 273 | is($tm->strftime('%z'), $exp, "$tm '%z'"); 274 | 275 | $exp = sprintf '%s%02d:%02d', $sign[$off >= 0], $h, $m; 276 | is($tm->strftime('%:z'), $exp, "$tm '%:z'"); 277 | 278 | $exp = $off == 0 ? 'Z' : $exp; 279 | is($tm->strftime('%Z'), $exp, "$tm '%Z'"); 280 | } 281 | } 282 | } 283 | } 284 | 285 | done_testing(); 286 | 287 | -------------------------------------------------------------------------------- /t/410_with_offset.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my $tm = Time::Moment->from_string("2012-12-24T12:30:45.123456789Z"); 13 | for my $offset (-1080, -600, -120, -60, -30, -1, 0, 1, 30, 60, 120, 600, 1080) { 14 | my $got = $tm->with_offset_same_instant($offset); 15 | 16 | my $prefix = "$tm->with_offset_same_instant($offset)"; 17 | is($got->epoch, $tm->epoch, "$prefix->epoch"); 18 | is($got->millisecond, 123, "$prefix->millisecond"); 19 | is($got->microsecond, 123456, "$prefix->microsecond"); 20 | is($got->nanosecond, 123456789, "$prefix->nanosecond"); 21 | 22 | is($got->utc_rd_as_seconds, 23 | $tm->utc_rd_as_seconds, 24 | "$prefix->utc_rd_as_seconds"); 25 | } 26 | } 27 | 28 | { 29 | my $tm = Time::Moment->from_string("2012-12-24T12:30:45.123456789Z"); 30 | for my $offset (-1080, -600, -120, -60, -30, -1, 0, 1, 30, 60, 120, 600, 1080) { 31 | my $got = $tm->with_offset_same_local($offset); 32 | 33 | my $prefix = "$tm->with_offset_same_local($offset)"; 34 | is($got->year, 2012, "$prefix->year"); 35 | is($got->month, 12, "$prefix->month"); 36 | is($got->day_of_month, 24, "$prefix->day_of_month"); 37 | is($got->hour, 12, "$prefix->hour"); 38 | is($got->minute, 30, "$prefix->minute"); 39 | is($got->second, 45, "$prefix->second"); 40 | is($got->millisecond, 123, "$prefix->millisecond"); 41 | is($got->microsecond, 123456, "$prefix->microsecond"); 42 | is($got->nanosecond, 123456789, "$prefix->nanosecond"); 43 | 44 | is($got->local_rd_as_seconds, 45 | $tm->local_rd_as_seconds, 46 | "$prefix->local_rd_as_seconds"); 47 | } 48 | } 49 | 50 | done_testing(); 51 | 52 | -------------------------------------------------------------------------------- /t/411_with_adjusters.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | use_ok('Time::Moment::Adjusters', qw[ NextDayOfWeek 10 | PreviousDayOfWeek 11 | NextOrSameDayOfWeek 12 | PreviousOrSameDayOfWeek 13 | FirstDayOfWeekInMonth 14 | LastDayOfWeekInMonth 15 | NthDayOfWeekInMonth 16 | WesternEasterSunday 17 | NearestMinuteInterval 18 | ]); 19 | } 20 | 21 | my $Sunday = Time::Moment->from_string('2018-W02-7T00Z'); 22 | 23 | { 24 | my @M = ( 25 | # M T W T F S S 26 | 7,1,2,3,4,5,6, # M 27 | 6,7,1,2,3,4,5, # T 28 | 5,6,7,1,2,3,4, # W 29 | 4,5,6,7,1,2,3, # T 30 | 3,4,5,6,7,1,2, # F 31 | 2,3,4,5,6,7,1, # S 32 | 1,2,3,4,5,6,7, # S 33 | ); 34 | 35 | foreach my $d1 (1..7) { 36 | my $tm = $Sunday->plus_days($d1); 37 | foreach my $d2 (1..7) { 38 | my $got = $tm->with(NextDayOfWeek($d2)); 39 | my $exp = $tm->plus_days($M[7 * $d1 + $d2 - 8]); 40 | is($got, $exp, "$tm->with(NextDayOfWeek($d2))"); 41 | } 42 | } 43 | 44 | foreach my $d1 (1..7) { 45 | my $tm = $Sunday->plus_days($d1); 46 | foreach my $d2 (1..7) { 47 | my $got = $tm->with(PreviousDayOfWeek($d2)); 48 | my $exp = $tm->minus_days($M[7 * $d2 + $d1 - 8]); 49 | is($got, $exp, "$tm->with(PreviousDayOfWeek($d2))"); 50 | } 51 | } 52 | } 53 | 54 | { 55 | my @M = ( 56 | # M T W T F S S 57 | 0,1,2,3,4,5,6, # M 58 | 6,0,1,2,3,4,5, # T 59 | 5,6,0,1,2,3,4, # W 60 | 4,5,6,0,1,2,3, # T 61 | 3,4,5,6,0,1,2, # F 62 | 2,3,4,5,6,0,1, # S 63 | 1,2,3,4,5,6,0, # S 64 | ); 65 | 66 | foreach my $d1 (1..7) { 67 | my $tm = $Sunday->plus_days($d1); 68 | foreach my $d2 (1..7) { 69 | my $got = $tm->with(NextOrSameDayOfWeek($d2)); 70 | my $exp = $tm->plus_days($M[7 * $d1 + $d2 - 8]); 71 | is($got, $exp, "$tm->with(NextOrSameDayOfWeek($d2))"); 72 | } 73 | } 74 | 75 | foreach my $d1 (1..7) { 76 | my $tm = $Sunday->plus_days($d1); 77 | foreach my $d2 (1..7) { 78 | my $got = $tm->with(PreviousOrSameDayOfWeek($d2)); 79 | my $exp = $tm->minus_days($M[7 * $d2 + $d1 - 8]); 80 | is($got, $exp, "$tm->with(PreviousOrSameDayOfWeek($d2))"); 81 | } 82 | } 83 | } 84 | 85 | my $Monday = Time::Moment->from_string('1996-01-01T00Z'); 86 | 87 | { 88 | my @M = (undef, 12, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11); 89 | 90 | for (my $tm = $Monday; $tm->year == $Monday->year; $tm = $tm->plus_days(1)) { 91 | foreach my $d1 (1..7) { 92 | my $got = $tm->with(FirstDayOfWeekInMonth($d1)); 93 | is($got->day_of_week, $d1, "$tm->with(FirstDayOfWeekInMonth($d1))->day_of_week == $d1"); 94 | is($got->month, $tm->month, "$tm->with(FirstDayOfWeekInMonth($d1))->month == $tm->month"); 95 | 96 | my $got2 = $got->minus_days(7); 97 | is($got2->month, $M[$got->month], "$tm->with(FirstDayOfWeekInMonth($d1))->minus_days(7)->month == $M[$got->month]"); 98 | } 99 | } 100 | } 101 | 102 | { 103 | my @M = (undef, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1); 104 | 105 | for (my $tm = $Monday; $tm->year == $Monday->year; $tm = $tm->plus_days(1)) { 106 | foreach my $d1 (1..7) { 107 | my $got = $tm->with(LastDayOfWeekInMonth($d1)); 108 | is($got->day_of_week, $d1, "$tm->with(LastDayOfWeekInMonth($d1))->day_of_week == $d1"); 109 | is($got->month, $tm->month, "$tm->with(LastDayOfWeekInMonth($d1))->month == $tm->month"); 110 | 111 | my $got2 = $got->plus_days(7); 112 | is($got2->month, $M[$got->month], "$tm->with(LastDayOfWeekInMonth($d1))->plus_days(7)->month == $M[$got->month]"); 113 | } 114 | } 115 | 116 | } 117 | 118 | { 119 | for my $m1 (1..12) { 120 | my $tm = $Monday->with_month($m1); 121 | for my $d1 (1..7) { 122 | for my $o1 (1..4, -4..-1) { 123 | my $got = $tm->with(NthDayOfWeekInMonth($o1, $d1)); 124 | is($got->day_of_week, $d1, "$tm->with(NthDayOfWeekInMonth($o1, $d1))->day_of_week == $d1"); 125 | is($got->month, $tm->month, "$tm->with(NthDayOfWeekInMonth($o1, $d1))->month == $tm->month"); 126 | 127 | if ($o1 > 0) { 128 | my $n = $o1 - 1; 129 | for my $o2 (1..$n) { 130 | my $got2 = $got->minus_days(7 * $o2); 131 | is($got2->month, $tm->month, "$got->minus_days(7 * $o2)->month == $tm->month"); 132 | } 133 | } else { 134 | my $n = abs($o1) - 1; 135 | for my $o2 (1..$n) { 136 | my $got2 = $got->plus_days(7 * $o2); 137 | is($got2->month, $tm->month, "$got->plus_days(7 * $o2)->month == $tm->month") 138 | or done_testing, exit; 139 | } 140 | } 141 | } 142 | 143 | } 144 | } 145 | } 146 | 147 | { 148 | my @WesternEasterSundays = qw( 149 | 1700-04-11 1725-04-01 1750-03-29 1775-04-16 150 | 1701-03-27 1726-04-21 1751-04-11 1776-04-07 151 | 1702-04-16 1727-04-13 1752-04-02 1777-03-30 152 | 1703-04-08 1728-03-28 1753-04-22 1778-04-19 153 | 1704-03-23 1729-04-17 1754-04-14 1779-04-04 154 | 1705-04-12 1730-04-09 1755-03-30 1780-03-26 155 | 1706-04-04 1731-03-25 1756-04-18 1781-04-15 156 | 1707-04-24 1732-04-13 1757-04-10 1782-03-31 157 | 1708-04-08 1733-04-05 1758-03-26 1783-04-20 158 | 1709-03-31 1734-04-25 1759-04-15 1784-04-11 159 | 1710-04-20 1735-04-10 1760-04-06 1785-03-27 160 | 1711-04-05 1736-04-01 1761-03-22 1786-04-16 161 | 1712-03-27 1737-04-21 1762-04-11 1787-04-08 162 | 1713-04-16 1738-04-06 1763-04-03 1788-03-23 163 | 1714-04-01 1739-03-29 1764-04-22 1789-04-12 164 | 1715-04-21 1740-04-17 1765-04-07 1790-04-04 165 | 1716-04-12 1741-04-02 1766-03-30 1791-04-24 166 | 1717-03-28 1742-03-25 1767-04-19 1792-04-08 167 | 1718-04-17 1743-04-14 1768-04-03 1793-03-31 168 | 1719-04-09 1744-04-05 1769-03-26 1794-04-20 169 | 1720-03-31 1745-04-18 1770-04-15 1795-04-05 170 | 1721-04-13 1746-04-10 1771-03-31 1796-03-27 171 | 1722-04-05 1747-04-02 1772-04-19 1797-04-16 172 | 1723-03-28 1748-04-14 1773-04-11 1798-04-08 173 | 1724-04-16 1749-04-06 1774-04-03 1799-03-24 174 | 175 | 1800-04-13 1825-04-03 1850-03-31 1875-03-28 176 | 1801-04-05 1826-03-26 1851-04-20 1876-04-16 177 | 1802-04-18 1827-04-15 1852-04-11 1877-04-01 178 | 1803-04-10 1828-04-06 1853-03-27 1878-04-21 179 | 1804-04-01 1829-04-19 1854-04-16 1879-04-13 180 | 1805-04-14 1830-04-11 1855-04-08 1880-03-28 181 | 1806-04-06 1831-04-03 1856-03-23 1881-04-17 182 | 1807-03-29 1832-04-22 1857-04-12 1882-04-09 183 | 1808-04-17 1833-04-07 1858-04-04 1883-03-25 184 | 1809-04-02 1834-03-30 1859-04-24 1884-04-13 185 | 1810-04-22 1835-04-19 1860-04-08 1885-04-05 186 | 1811-04-14 1836-04-03 1861-03-31 1886-04-25 187 | 1812-03-29 1837-03-26 1862-04-20 1887-04-10 188 | 1813-04-18 1838-04-15 1863-04-05 1888-04-01 189 | 1814-04-10 1839-03-31 1864-03-27 1889-04-21 190 | 1815-03-26 1840-04-19 1865-04-16 1890-04-06 191 | 1816-04-14 1841-04-11 1866-04-01 1891-03-29 192 | 1817-04-06 1842-03-27 1867-04-21 1892-04-17 193 | 1818-03-22 1843-04-16 1868-04-12 1893-04-02 194 | 1819-04-11 1844-04-07 1869-03-28 1894-03-25 195 | 1820-04-02 1845-03-23 1870-04-17 1895-04-14 196 | 1821-04-22 1846-04-12 1871-04-09 1896-04-05 197 | 1822-04-07 1847-04-04 1872-03-31 1897-04-18 198 | 1823-03-30 1848-04-23 1873-04-13 1898-04-10 199 | 1824-04-18 1849-04-08 1874-04-05 1899-04-02 200 | 201 | 1900-04-15 1925-04-12 1950-04-09 1975-03-30 202 | 1901-04-07 1926-04-04 1951-03-25 1976-04-18 203 | 1902-03-30 1927-04-17 1952-04-13 1977-04-10 204 | 1903-04-12 1928-04-08 1953-04-05 1978-03-26 205 | 1904-04-03 1929-03-31 1954-04-18 1979-04-15 206 | 1905-04-23 1930-04-20 1955-04-10 1980-04-06 207 | 1906-04-15 1931-04-05 1956-04-01 1981-04-19 208 | 1907-03-31 1932-03-27 1957-04-21 1982-04-11 209 | 1908-04-19 1933-04-16 1958-04-06 1983-04-03 210 | 1909-04-11 1934-04-01 1959-03-29 1984-04-22 211 | 1910-03-27 1935-04-21 1960-04-17 1985-04-07 212 | 1911-04-16 1936-04-12 1961-04-02 1986-03-30 213 | 1912-04-07 1937-03-28 1962-04-22 1987-04-19 214 | 1913-03-23 1938-04-17 1963-04-14 1988-04-03 215 | 1914-04-12 1939-04-09 1964-03-29 1989-03-26 216 | 1915-04-04 1940-03-24 1965-04-18 1990-04-15 217 | 1916-04-23 1941-04-13 1966-04-10 1991-03-31 218 | 1917-04-08 1942-04-05 1967-03-26 1992-04-19 219 | 1918-03-31 1943-04-25 1968-04-14 1993-04-11 220 | 1919-04-20 1944-04-09 1969-04-06 1994-04-03 221 | 1920-04-04 1945-04-01 1970-03-29 1995-04-16 222 | 1921-03-27 1946-04-21 1971-04-11 1996-04-07 223 | 1922-04-16 1947-04-06 1972-04-02 1997-03-30 224 | 1923-04-01 1948-03-28 1973-04-22 1998-04-12 225 | 1924-04-20 1949-04-17 1974-04-14 1999-04-04 226 | 227 | 2000-04-23 2025-04-20 2050-04-10 2075-04-07 228 | 2001-04-15 2026-04-05 2051-04-02 2076-04-19 229 | 2002-03-31 2027-03-28 2052-04-21 2077-04-11 230 | 2003-04-20 2028-04-16 2053-04-06 2078-04-03 231 | 2004-04-11 2029-04-01 2054-03-29 2079-04-23 232 | 2005-03-27 2030-04-21 2055-04-18 2080-04-07 233 | 2006-04-16 2031-04-13 2056-04-02 2081-03-30 234 | 2007-04-08 2032-03-28 2057-04-22 2082-04-19 235 | 2008-03-23 2033-04-17 2058-04-14 2083-04-04 236 | 2009-04-12 2034-04-09 2059-03-30 2084-03-26 237 | 2010-04-04 2035-03-25 2060-04-18 2085-04-15 238 | 2011-04-24 2036-04-13 2061-04-10 2086-03-31 239 | 2012-04-08 2037-04-05 2062-03-26 2087-04-20 240 | 2013-03-31 2038-04-25 2063-04-15 2088-04-11 241 | 2014-04-20 2039-04-10 2064-04-06 2089-04-03 242 | 2015-04-05 2040-04-01 2065-03-29 2090-04-16 243 | 2016-03-27 2041-04-21 2066-04-11 2091-04-08 244 | 2017-04-16 2042-04-06 2067-04-03 2092-03-30 245 | 2018-04-01 2043-03-29 2068-04-22 2093-04-12 246 | 2019-04-21 2044-04-17 2069-04-14 2094-04-04 247 | 2020-04-12 2045-04-09 2070-03-30 2095-04-24 248 | 2021-04-04 2046-03-25 2071-04-19 2096-04-15 249 | 2022-04-17 2047-04-14 2072-04-10 2097-03-31 250 | 2023-04-09 2048-04-05 2073-03-26 2098-04-20 251 | 2024-03-31 2049-04-18 2074-04-15 2099-04-12 252 | 253 | 2100-03-28 2125-04-22 2150-04-12 2175-04-09 254 | 2101-04-17 2126-04-14 2151-04-04 2176-03-31 255 | 2102-04-09 2127-03-30 2152-04-23 2177-04-20 256 | 2103-03-25 2128-04-18 2153-04-15 2178-04-05 257 | 2104-04-13 2129-04-10 2154-03-31 2179-03-28 258 | 2105-04-05 2130-03-26 2155-04-20 2180-04-16 259 | 2106-04-18 2131-04-15 2156-04-11 2181-04-01 260 | 2107-04-10 2132-04-06 2157-03-27 2182-04-21 261 | 2108-04-01 2133-04-19 2158-04-16 2183-04-13 262 | 2109-04-21 2134-04-11 2159-04-08 2184-03-28 263 | 2110-04-06 2135-04-03 2160-03-23 2185-04-17 264 | 2111-03-29 2136-04-22 2161-04-12 2186-04-09 265 | 2112-04-17 2137-04-07 2162-04-04 2187-03-25 266 | 2113-04-02 2138-03-30 2163-04-24 2188-04-13 267 | 2114-04-22 2139-04-19 2164-04-08 2189-04-05 268 | 2115-04-14 2140-04-03 2165-03-31 2190-04-25 269 | 2116-03-29 2141-03-26 2166-04-20 2191-04-10 270 | 2117-04-18 2142-04-15 2167-04-05 2192-04-01 271 | 2118-04-10 2143-03-31 2168-03-27 2193-04-21 272 | 2119-03-26 2144-04-19 2169-04-16 2194-04-06 273 | 2120-04-14 2145-04-11 2170-04-01 2195-03-29 274 | 2121-04-06 2146-04-03 2171-04-21 2196-04-17 275 | 2122-03-29 2147-04-16 2172-04-12 2197-04-09 276 | 2123-04-11 2148-04-07 2173-04-04 2198-03-25 277 | 2124-04-02 2149-03-30 2174-04-17 2199-04-14 278 | ); 279 | 280 | for my $date (@WesternEasterSundays) { 281 | my $exp = Time::Moment->from_string($date . "T00Z"); 282 | my $tm = Time::Moment->new(year => $exp->year); 283 | my $got = $tm->with(WesternEasterSunday); 284 | is($got, $exp, "$tm->with(WesternEasterSunday) == $got"); 285 | } 286 | } 287 | 288 | { 289 | for my $plus_unit (qw(plus_nanoseconds plus_microseconds plus_seconds)) { 290 | my $tm = $Sunday->$plus_unit(1); 291 | my $got = $tm->with(NearestMinuteInterval(1)); 292 | my $exp = $Sunday; 293 | is($got, $exp, "$tm->with(NearestMinuteInterval(1)) == $exp"); 294 | } 295 | 296 | my %T = ( 297 | '2018-01-01T10:14:59Z' => '2018-01-01T10:00:00Z', 298 | '2018-01-01T10:15:00Z' => '2018-01-01T10:30:00Z', 299 | '2018-01-01T10:29:59Z' => '2018-01-01T10:30:00Z', 300 | '2018-01-01T23:55:00Z' => '2018-01-02T00:00:00Z', 301 | ); 302 | 303 | while (my ($from, $to) = each %T) { 304 | my $tm = Time::Moment->from_string($from); 305 | my $exp = Time::Moment->from_string($to); 306 | my $got = $tm->with(NearestMinuteInterval(30)); 307 | is($got, $exp, "$tm->with(NearestMinuteInterval(30)) == $exp"); 308 | } 309 | } 310 | 311 | done_testing(); 312 | -------------------------------------------------------------------------------- /t/415_precision.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my $tm = Time::Moment->from_string('2012-12-24T12:30:45.123456789Z'); 13 | my @tests = ( 14 | [ 9, '2012-12-24T12:30:45.123456789Z' ], 15 | [ 8, '2012-12-24T12:30:45.123456780Z' ], 16 | [ 7, '2012-12-24T12:30:45.123456700Z' ], 17 | [ 6, '2012-12-24T12:30:45.123456Z' ], 18 | [ 5, '2012-12-24T12:30:45.123450Z' ], 19 | [ 4, '2012-12-24T12:30:45.123400Z' ], 20 | [ 3, '2012-12-24T12:30:45.123Z' ], 21 | [ 2, '2012-12-24T12:30:45.120Z' ], 22 | [ 1, '2012-12-24T12:30:45.100Z' ], 23 | [ 0, '2012-12-24T12:30:45Z' ], 24 | [ -1, '2012-12-24T12:30:00Z' ], 25 | [ -2, '2012-12-24T12:00:00Z' ], 26 | [ -3, '2012-12-24T00:00:00Z' ], 27 | ); 28 | 29 | for my $test (@tests) { 30 | my ($precision, $string) = @$test; 31 | my $got = $tm->with_precision($precision); 32 | is($got->to_string, $string, "->with_precision($precision)"); 33 | is($got->precision, $precision, "$got->precision"); 34 | } 35 | } 36 | 37 | { 38 | my $tm = Time::Moment->from_string('2012-12-24T12:30:45.123456789+14:30'); 39 | my @tests = ( 40 | [ 9, '2012-12-24T12:30:45.123456789+14:30' ], 41 | [ 8, '2012-12-24T12:30:45.123456780+14:30' ], 42 | [ 7, '2012-12-24T12:30:45.123456700+14:30' ], 43 | [ 6, '2012-12-24T12:30:45.123456+14:30' ], 44 | [ 5, '2012-12-24T12:30:45.123450+14:30' ], 45 | [ 4, '2012-12-24T12:30:45.123400+14:30' ], 46 | [ 3, '2012-12-24T12:30:45.123+14:30' ], 47 | [ 2, '2012-12-24T12:30:45.120+14:30' ], 48 | [ 1, '2012-12-24T12:30:45.100+14:30' ], 49 | [ 0, '2012-12-24T12:30:45+14:30' ], 50 | [ -1, '2012-12-24T12:30:00+14:30' ], 51 | [ -2, '2012-12-24T12:00:00+14:30' ], 52 | [ -3, '2012-12-24T00:00:00+14:30' ], 53 | ); 54 | 55 | for my $test (@tests) { 56 | my ($precision, $string) = @$test; 57 | my $got = $tm->with_precision($precision); 58 | is($got->to_string, $string, "->with_precision($precision)"); 59 | is($got->precision, $precision, "$got->precision"); 60 | } 61 | } 62 | 63 | { 64 | my $tm = Time::Moment->from_string('2012-12-24T12:30:45.123456789-14:30'); 65 | my @tests = ( 66 | [ 9, '2012-12-24T12:30:45.123456789-14:30' ], 67 | [ 8, '2012-12-24T12:30:45.123456780-14:30' ], 68 | [ 7, '2012-12-24T12:30:45.123456700-14:30' ], 69 | [ 6, '2012-12-24T12:30:45.123456-14:30' ], 70 | [ 5, '2012-12-24T12:30:45.123450-14:30' ], 71 | [ 4, '2012-12-24T12:30:45.123400-14:30' ], 72 | [ 3, '2012-12-24T12:30:45.123-14:30' ], 73 | [ 2, '2012-12-24T12:30:45.120-14:30' ], 74 | [ 1, '2012-12-24T12:30:45.100-14:30' ], 75 | [ 0, '2012-12-24T12:30:45-14:30' ], 76 | [ -1, '2012-12-24T12:30:00-14:30' ], 77 | [ -2, '2012-12-24T12:00:00-14:30' ], 78 | [ -3, '2012-12-24T00:00:00-14:30' ], 79 | ); 80 | 81 | for my $test (@tests) { 82 | my ($precision, $string) = @$test; 83 | my $got = $tm->with_precision($precision); 84 | is($got->to_string, $string, "->with_precision($precision)"); 85 | is($got->precision, $precision, "$got->precision"); 86 | } 87 | } 88 | 89 | done_testing(); 90 | 91 | -------------------------------------------------------------------------------- /t/420_at.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my $tm = Time::Moment->from_string('2012-12-24T12:30:45.123456789Z'); 13 | is($tm->at_noon, '2012-12-24T12:00:00Z', '->at_noon'); 14 | is($tm->at_midnight, '2012-12-24T00:00:00Z', '->at_midnight'); 15 | is($tm->at_utc, '2012-12-24T12:30:45.123456789Z', '->at_utc'); 16 | } 17 | 18 | { 19 | my $tm = Time::Moment->from_string('2012-12-24T12:30:45.123456789+02:00'); 20 | is($tm->at_noon, '2012-12-24T12:00:00+02:00', '->at_noon'); 21 | is($tm->at_midnight, '2012-12-24T00:00:00+02:00', '->at_midnight'); 22 | is($tm->at_utc, '2012-12-24T10:30:45.123456789Z', '->at_utc'); 23 | } 24 | 25 | { 26 | my $tm = Time::Moment->from_string('2012-12-24T12:30:45.123456789-02:00'); 27 | is($tm->at_noon, '2012-12-24T12:00:00-02:00', '->at_noon'); 28 | is($tm->at_midnight, '2012-12-24T00:00:00-02:00', '->at_midnight'); 29 | is($tm->at_utc, '2012-12-24T14:30:45.123456789Z', '->at_utc'); 30 | } 31 | 32 | 33 | { 34 | my $tm = Time::Moment->new(year => 2012); 35 | my $exp = $tm->with_day_of_year(366); 36 | my $got = $tm->at_last_day_of_year; 37 | is($got, $exp, "->at_last_day_of_year (leap year)"); 38 | } 39 | 40 | { 41 | my $tm = Time::Moment->new(year => 2013); 42 | my $exp = $tm->with_day_of_year(365); 43 | my $got = $tm->at_last_day_of_year; 44 | is($got, $exp, "->at_last_day_of_year (common year)"); 45 | } 46 | 47 | { 48 | # Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 49 | my @months = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 50 | my $year = Time::Moment->new(year => 2012); 51 | my $month = 0; 52 | foreach my $day (@months) { 53 | ++$month; 54 | my $exp = $year->with_month($month) 55 | ->with_day_of_month($day); 56 | my $got = $year->with_month($month) 57 | ->at_last_day_of_month; 58 | is($got, $exp, "->at_last_day_of_month (leap year)"); 59 | } 60 | } 61 | 62 | { 63 | # Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 64 | my @months = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 65 | my $year = Time::Moment->new(year => 2013); 66 | my $month = 0; 67 | foreach my $day (@months) { 68 | ++$month; 69 | my $exp = $year->with_month($month) 70 | ->with_day_of_month($day); 71 | my $got = $year->with_month($month) 72 | ->at_last_day_of_month; 73 | is($got, $exp, "->at_last_day_of_month (common year)"); 74 | } 75 | } 76 | 77 | { 78 | # Q1 Q2 Q3 Q4 79 | my @quarters = (91, 91, 92, 92); 80 | my $year = Time::Moment->new(year => 2012); 81 | my $quarter = 0; 82 | foreach my $day (@quarters) { 83 | ++$quarter; 84 | my $exp = $year->with_month(3 * $quarter) 85 | ->with_day_of_quarter($day); 86 | my $got = $year->with_month(3 * $quarter) 87 | ->at_last_day_of_quarter; 88 | is($got, $exp, "->at_last_day_of_quarter (leap year)"); 89 | } 90 | } 91 | 92 | { 93 | # Q1 Q2 Q3 Q4 94 | my @quarters = (90, 91, 92, 92); 95 | my $year = Time::Moment->new(year => 2013); 96 | my $quarter = 0; 97 | foreach my $day (@quarters) { 98 | ++$quarter; 99 | my $exp = $year->with_month(3 * $quarter) 100 | ->with_day_of_quarter($day); 101 | my $got = $year->with_month(3 * $quarter) 102 | ->at_last_day_of_quarter; 103 | is($got, $exp, "->at_last_day_of_quarter (common year)"); 104 | } 105 | } 106 | 107 | { 108 | my $tm = Time::Moment->from_string('2012-12-24T12:30:45.123+02:00'); 109 | is($tm->at_last_day_of_year, '2012-12-31T12:30:45.123+02:00', '->at_last_day_of_year'); 110 | is($tm->at_last_day_of_quarter, '2012-12-31T12:30:45.123+02:00', '->at_last_day_of_quarter'); 111 | is($tm->at_last_day_of_month, '2012-12-31T12:30:45.123+02:00', '->at_last_day_of_month'); 112 | } 113 | 114 | { 115 | my $tm = Time::Moment->from_string('2012-01-24T12:30:45.123-02:00'); 116 | is($tm->at_last_day_of_year, '2012-12-31T12:30:45.123-02:00', '->at_last_day_of_year'); 117 | is($tm->at_last_day_of_quarter, '2012-03-31T12:30:45.123-02:00', '->at_last_day_of_quarter'); 118 | is($tm->at_last_day_of_month, '2012-01-31T12:30:45.123-02:00', '->at_last_day_of_month'); 119 | } 120 | 121 | { 122 | my $tm = Time::Moment->from_string('2012-07-24T12:30:45.123Z'); 123 | is($tm->at_last_day_of_year, '2012-12-31T12:30:45.123Z', '->at_last_day_of_year'); 124 | is($tm->at_last_day_of_quarter, '2012-09-30T12:30:45.123Z', '->at_last_day_of_quarter'); 125 | is($tm->at_last_day_of_month, '2012-07-31T12:30:45.123Z', '->at_last_day_of_month'); 126 | } 127 | 128 | done_testing(); 129 | 130 | -------------------------------------------------------------------------------- /t/430_length.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my $tm = Time::Moment->new(year => 2012); 13 | is($tm->length_of_year, 366, "length of year in a leap year is 366"); 14 | } 15 | 16 | { 17 | my $tm = Time::Moment->new(year => 2013); 18 | is($tm->length_of_year, 365, "length of year in a common year is 365"); 19 | } 20 | 21 | { 22 | # Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 23 | my @lengths = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 24 | my $year = Time::Moment->new(year => 2012); 25 | my $month = 1; 26 | foreach my $length (@lengths) { 27 | my $tm = $year->with_month($month++); 28 | is($tm->length_of_month, $length, "length of month $month is $length in a leap year"); 29 | } 30 | } 31 | 32 | { 33 | # Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 34 | my @lengths = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); 35 | my $year = Time::Moment->new(year => 2013); 36 | my $month = 1; 37 | foreach my $length (@lengths) { 38 | my $tm = $year->with_month($month++); 39 | is($tm->length_of_month, $length, "length of month $month is $length in a common year"); 40 | } 41 | } 42 | 43 | { 44 | # Q1 Q2 Q3 Q4 45 | my @lengths = (91, 91, 92, 92); 46 | my $year = Time::Moment->new(year => 2012); 47 | my $quarter = 1; 48 | foreach my $length (@lengths) { 49 | my $tm = $year->with_month(3 * $quarter++); 50 | is($tm->length_of_quarter, $length, "length of quarter $quarter is $length in a leap year"); 51 | } 52 | } 53 | 54 | { 55 | # Q1 Q2 Q3 Q4 56 | my @lengths = (90, 91, 92, 92); 57 | my $year = Time::Moment->new(year => 2013); 58 | my $quarter = 1; 59 | foreach my $length (@lengths) { 60 | my $tm = $year->with_month(3 * $quarter++); 61 | is($tm->length_of_quarter, $length, "length of quarter $quarter is $length in a common year"); 62 | } 63 | } 64 | 65 | done_testing(); 66 | -------------------------------------------------------------------------------- /t/450_delta_time.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my $tm = Time::Moment->from_string('2012-12-24T15:30:45.123456789Z'); 13 | for my $n (-20..20) { 14 | my $x = $n * ($n ** 4); 15 | 16 | { 17 | my $exp = $x; 18 | { 19 | my $got = $tm->delta_hours($tm->plus_hours($x)); 20 | is($got, $exp, "delta_hours(plus_hours($x))"); 21 | } 22 | { 23 | my $got = $tm->delta_minutes($tm->plus_minutes($x)); 24 | is($got, $exp, "delta_minutes(plus_minutes($x))"); 25 | } 26 | { 27 | my $got = $tm->delta_seconds($tm->plus_seconds($x)); 28 | is($got, $exp, "delta_seconds(plus_seconds($x))"); 29 | } 30 | { 31 | my $got = $tm->delta_milliseconds($tm->plus_milliseconds($x)); 32 | is($got, $exp, "delta_milliseconds(plus_milliseconds($x))"); 33 | } 34 | { 35 | my $got = $tm->delta_microseconds($tm->plus_microseconds($x)); 36 | is($got, $exp, "delta_microseconds(plus_microseconds($x))"); 37 | } 38 | { 39 | my $got = $tm->delta_nanoseconds($tm->plus_nanoseconds($x)); 40 | is($got, $exp, "delta_nanoseconds(plus_nanoseconds($x))"); 41 | } 42 | } 43 | { 44 | my $exp = -$x; 45 | { 46 | my $got = $tm->delta_hours($tm->minus_hours($x)); 47 | is($got, $exp, "delta_hours(minus_hours($x))"); 48 | } 49 | { 50 | my $got = $tm->delta_minutes($tm->minus_minutes($x)); 51 | is($got, $exp, "delta_minutes(minus_minutes($x))"); 52 | } 53 | { 54 | my $got = $tm->delta_seconds($tm->minus_seconds($x)); 55 | is($got, $exp, "delta_seconds(minus_seconds($x))"); 56 | } 57 | { 58 | my $got = $tm->delta_milliseconds($tm->minus_milliseconds($x)); 59 | is($got, $exp, "delta_milliseconds(minus_milliseconds($x))"); 60 | } 61 | { 62 | my $got = $tm->delta_microseconds($tm->minus_microseconds($x)); 63 | is($got, $exp, "delta_microseconds(minus_microseconds($x))"); 64 | } 65 | { 66 | my $got = $tm->delta_nanoseconds($tm->minus_nanoseconds($x)); 67 | is($got, $exp, "delta_nanoseconds(minus_nanoseconds($x))"); 68 | } 69 | } 70 | } 71 | } 72 | 73 | { 74 | my $tm1 = Time::Moment->from_string('2012-12-24T15:30:45Z'); 75 | for my $h (-10, -1, 0, 1, 10) { 76 | my $tm2 = $tm1->with_offset_same_instant($h*60); 77 | is($tm1->delta_hours($tm2), 0, "$tm1->delta_hours($tm2)"); 78 | is($tm1->delta_minutes($tm2), 0, "$tm1->delta_minutes($tm2)"); 79 | is($tm1->delta_seconds($tm2), 0, "$tm1->delta_seconds($tm2)"); 80 | is($tm1->delta_milliseconds($tm2), 0, "$tm1->delta_milliseconds($tm2)"); 81 | is($tm1->delta_microseconds($tm2), 0, "$tm1->delta_microseconds($tm2)"); 82 | is($tm1->delta_nanoseconds($tm2), 0, "$tm1->delta_nanoseconds($tm2)"); 83 | 84 | is($tm2->delta_hours($tm1), 0, "$tm2->delta_hours($tm1)"); 85 | is($tm2->delta_minutes($tm1), 0, "$tm2->delta_minutes($tm1)"); 86 | is($tm2->delta_seconds($tm1), 0, "$tm2->delta_seconds($tm1)"); 87 | is($tm2->delta_milliseconds($tm1), 0, "$tm2->delta_milliseconds($tm1)"); 88 | is($tm2->delta_microseconds($tm1), 0, "$tm2->delta_microseconds($tm1)"); 89 | is($tm2->delta_nanoseconds($tm1), 0, "$tm2->delta_nanoseconds($tm1)"); 90 | } 91 | } 92 | 93 | { 94 | my $tm1 = Time::Moment->from_string('2012-12-24T15:30:45Z'); 95 | for my $h (-10, -1, 0, 1, 10) { 96 | my $tm2 = $tm1->with_offset_same_local($h*60); 97 | is($tm1->delta_hours($tm2), -$h, "$tm1->delta_hours($tm2)"); 98 | is($tm1->delta_minutes($tm2), -$h*60, "$tm1->delta_minutes($tm2)"); 99 | is($tm1->delta_seconds($tm2), -$h*60*60, "$tm1->delta_seconds($tm2)"); 100 | is($tm1->delta_milliseconds($tm2), -$h*60*60*1E3, "$tm1->delta_milliseconds($tm2)"); 101 | is($tm1->delta_microseconds($tm2), -$h*60*60*1E6, "$tm1->delta_microseconds($tm2)"); 102 | is($tm1->delta_nanoseconds($tm2), -$h*60*60*1E9, "$tm1->delta_nanoseconds($tm2)"); 103 | 104 | is($tm2->delta_hours($tm1), $h, "$tm2->delta_hours($tm1)"); 105 | is($tm2->delta_minutes($tm1), $h*60, "$tm2->delta_minutes($tm1)"); 106 | is($tm2->delta_seconds($tm1), $h*60*60, "$tm2->delta_seconds($tm1)"); 107 | is($tm2->delta_milliseconds($tm1), $h*60*60*1E3, "$tm2->delta_milliseconds($tm1)"); 108 | is($tm2->delta_microseconds($tm1), $h*60*60*1E6, "$tm2->delta_microseconds($tm1)"); 109 | is($tm2->delta_nanoseconds($tm1), $h*60*60*1E9, "$tm2->delta_nanoseconds($tm1)"); 110 | } 111 | } 112 | 113 | done_testing(); 114 | -------------------------------------------------------------------------------- /t/455_delta_date.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | { 12 | my $tm = Time::Moment->from_string('2012-12-24T15:30:45.123456789Z'); 13 | for my $n (-10..10) { 14 | my $x = $n * ($n ** 2); 15 | 16 | { 17 | my $exp = $x; 18 | { 19 | my $got = $tm->delta_years($tm->plus_years($x)); 20 | is($got, $exp, "delta_years(plus_years($x))"); 21 | } 22 | { 23 | my $got = $tm->delta_months($tm->plus_months($x)); 24 | is($got, $exp, "delta_months(plus_months($x))"); 25 | } 26 | { 27 | my $got = $tm->delta_weeks($tm->plus_weeks($x)); 28 | is($got, $exp, "delta_weeks(plus_weeks($x))"); 29 | } 30 | { 31 | my $got = $tm->delta_days($tm->plus_days($x)); 32 | is($got, $exp, "delta_days(plus_days($x))"); 33 | } 34 | } 35 | { 36 | my $exp = -$x; 37 | { 38 | my $got = $tm->delta_years($tm->minus_years($x)); 39 | is($got, $exp, "delta_years(minus_years($x))"); 40 | } 41 | { 42 | my $got = $tm->delta_months($tm->minus_months($x)); 43 | is($got, $exp, "delta_months(minus_months($x))"); 44 | } 45 | { 46 | my $got = $tm->delta_weeks($tm->minus_weeks($x)); 47 | is($got, $exp, "delta_weeks(minus_weeks($x))"); 48 | } 49 | { 50 | my $got = $tm->delta_days($tm->minus_days($x)); 51 | is($got, $exp, "delta_days(minus_days($x))"); 52 | } 53 | } 54 | } 55 | } 56 | 57 | { 58 | my $tm1 = Time::Moment->from_string('2012-12-23T15:30:45+12'); 59 | my $tm2 = Time::Moment->from_string('2012-12-24T15:30:45-12'); 60 | is($tm1->delta_days($tm2), 1, "$tm1->delta_days($tm2)"); 61 | } 62 | 63 | { 64 | my $tm1 = Time::Moment->from_string('2012-10-23T15:30:45+12'); 65 | my $tm2 = Time::Moment->from_string('2012-12-22T15:30:45-12'); 66 | is($tm1->delta_months($tm2), 1, "$tm1->delta_months($tm2)"); 67 | } 68 | 69 | { 70 | my $tm1 = Time::Moment->from_string('2012-10-23T15:30:45+12'); 71 | my $tm2 = Time::Moment->from_string('2012-12-23T15:30:45-12'); 72 | is($tm1->delta_months($tm2), 2, "$tm1->delta_months($tm2)"); 73 | } 74 | 75 | done_testing(); 76 | -------------------------------------------------------------------------------- /t/500_storable.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires qw[Storable]; 8 | use Util qw[throws_ok lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my ($tm, $freezed, $thawed); 16 | 17 | $tm = Time::Moment->from_string("2012-12-24T15:30:45.123456789+01:00"); 18 | lives_ok { $freezed = Storable::nfreeze($tm) } 'Storable::nfreeze()'; 19 | lives_ok { $thawed = Storable::thaw($freezed) } 'Storable::thaw()'; 20 | isa_ok($thawed, 'Time::Moment'); 21 | is($thawed, '2012-12-24T15:30:45.123456789+01:00'); 22 | } 23 | 24 | { 25 | my ($tm, $freezed, $thawed); 26 | 27 | $tm = Time::Moment->from_string("2012-12-24T15:30:45.123456789-01:00"); 28 | lives_ok { $freezed = Storable::nfreeze($tm) } 'Storable::nfreeze()'; 29 | lives_ok { $thawed = Storable::thaw($freezed) } 'Storable::thaw()'; 30 | isa_ok($thawed, 'Time::Moment'); 31 | is($thawed, '2012-12-24T15:30:45.123456789-01:00'); 32 | } 33 | 34 | { 35 | my ($tm, $cloned); 36 | 37 | $tm = Time::Moment->from_string("2012-12-24T15:30:45.123456789+01:00"); 38 | lives_ok { $cloned = Storable::dclone($tm) } 'Storable::dclone()'; 39 | isa_ok($cloned, 'Time::Moment'); 40 | is($cloned, '2012-12-24T15:30:45.123456789+01:00'); 41 | } 42 | 43 | done_testing(); 44 | 45 | -------------------------------------------------------------------------------- /t/510_json.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires qw[JSON::XS]; 8 | use Util qw[throws_ok lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my ($tm, $json, $serialized); 16 | 17 | $json = JSON::XS->new->convert_blessed; 18 | $tm = Time::Moment->from_string("2012-12-24T15:30:45.123456789+01:00"); 19 | lives_ok { $serialized = $json->encode([$tm]) } '$json->encode()'; 20 | ok(index($serialized, '2012-12-24T15:30:45.123456789+01:00') != -1, "serialized contains timestamp"); 21 | } 22 | 23 | done_testing(); 24 | 25 | -------------------------------------------------------------------------------- /t/520_cbor.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires { 'CBOR::XS' => '1.25' }; 8 | use Util qw[throws_ok lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my ($tm, $encoded, $decoded); 16 | 17 | $tm = Time::Moment->from_string("2012-12-24T15:30:45.123456789+01:00"); 18 | lives_ok { 19 | $encoded = CBOR::XS::encode_cbor([$tm]) 20 | } 'encode_cbor()'; 21 | 22 | lives_ok { 23 | $decoded = CBOR::XS->new->filter(sub { return $_[1] })->decode($encoded); 24 | } '$cbor->decode()'; 25 | 26 | is_deeply($decoded, ['2012-12-24T15:30:45.123456789+01:00'], 'decoded values'); 27 | } 28 | 29 | done_testing(); 30 | 31 | -------------------------------------------------------------------------------- /t/530_sereal.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires { Sereal => '2.060' }; 8 | use Util qw[throws_ok lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my ($tm, $encoded, $decoded); 16 | 17 | my @moments = map { 18 | Time::Moment->from_string($_) 19 | } qw[2012-12-24T15:30:45.123456789+01:00 20 | 2012-12-24T15:30:45.987654321+01:00]; 21 | 22 | lives_ok { 23 | $encoded = Sereal::encode_sereal([@moments], { freeze_callbacks => 1 }) 24 | } 'Sereal::encode_sereal()'; 25 | 26 | lives_ok { 27 | $decoded = Sereal::decode_sereal($encoded); 28 | } 'Sereal::decode_sereal()'; 29 | 30 | isa_ok($decoded, 'ARRAY'); 31 | is(scalar @$decoded, 2, 'ARRAY has two elements'); 32 | isa_ok($decoded->[0], 'Time::Moment', 'first element'); 33 | isa_ok($decoded->[1], 'Time::Moment', 'second element'); 34 | is($decoded->[0]->to_string, $moments[0]->to_string, 'first element has right time'); 35 | is($decoded->[1]->to_string, $moments[1]->to_string, 'second element has right time'); 36 | } 37 | 38 | done_testing(); 39 | 40 | -------------------------------------------------------------------------------- /t/600_coerce_dt.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires qw[Params::Coerce DateTime]; 8 | use Util qw[throws_ok lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my $dt = DateTime->from_epoch(epoch => 123456789); 16 | my $tm; 17 | 18 | lives_ok { $tm = Params::Coerce::coerce('Time::Moment', $dt) }; 19 | isa_ok($tm, 'Time::Moment'); 20 | is($tm->epoch, 123456789, '->epoch'); 21 | } 22 | 23 | { 24 | my $dt = DateTime->new(year => 2012); 25 | throws_ok { 26 | Params::Coerce::coerce('Time::Moment', $dt) 27 | } qr/^Cannot coerce .* 'floating'/; 28 | } 29 | 30 | { 31 | my $tm = Time::Moment->from_epoch(123456789); 32 | my $dt; 33 | 34 | lives_ok { $dt = Params::Coerce::coerce('DateTime', $tm) }; 35 | isa_ok($dt, 'DateTime'); 36 | is($dt->epoch, 123456789, '->epoch'); 37 | } 38 | 39 | done_testing(); 40 | 41 | -------------------------------------------------------------------------------- /t/610_coerce_tp.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use lib 't'; 5 | 6 | use Test::More; 7 | use Test::Requires qw[Params::Coerce Time::Piece]; 8 | use Util qw[lives_ok]; 9 | 10 | BEGIN { 11 | use_ok('Time::Moment'); 12 | } 13 | 14 | { 15 | my $tp = Time::Piece::gmtime(123456789); 16 | my $tm; 17 | 18 | lives_ok { $tm = Params::Coerce::coerce('Time::Moment', $tp) }; 19 | isa_ok($tm, 'Time::Moment'); 20 | is($tm->epoch, 123456789, '->epoch'); 21 | } 22 | 23 | { 24 | my $tm = Time::Moment->from_epoch(123456789); 25 | my $tp; 26 | 27 | lives_ok { $tp = Params::Coerce::coerce('Time::Piece', $tm) }; 28 | isa_ok($tp, 'Time::Piece'); 29 | is($tp->epoch, 123456789, '->epoch'); 30 | } 31 | 32 | done_testing(); 33 | 34 | -------------------------------------------------------------------------------- /t/900_bug_reuse.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | 7 | BEGIN { 8 | use_ok('Time::Moment'); 9 | } 10 | 11 | # Test cases for issue #7 12 | # https://github.com/chansen/p5-time-moment/issues/7 13 | 14 | { 15 | package MyObject; 16 | 17 | sub new { 18 | @_ == 2 || die; 19 | my ($class, $moment) = @_; 20 | return bless { moment => $moment }, $class; 21 | } 22 | 23 | sub moment { 24 | return $_[0]->{moment}; 25 | } 26 | } 27 | 28 | { 29 | my $tm1 = Time::Moment->from_string('0001-01-01T00:00:00Z'); 30 | my $obj = MyObject->new($tm1); 31 | my $tm2 = $obj->moment->plus_seconds(1); 32 | 33 | is($tm1, '0001-01-01T00:00:00Z', '$tm1'); 34 | is($tm2, '0001-01-01T00:00:01Z', '$tm2'); 35 | } 36 | 37 | { 38 | my $tm = Time::Moment->from_string('0001-01-01T00:00:00Z'); 39 | my @moments = map { sub { $tm }->()->plus_seconds($_) } (0..3); 40 | 41 | is($moments[0], '0001-01-01T00:00:00Z', '$moments[0]'); 42 | is($moments[1], '0001-01-01T00:00:01Z', '$moments[1]'); 43 | is($moments[2], '0001-01-01T00:00:02Z', '$moments[2]'); 44 | is($moments[3], '0001-01-01T00:00:03Z', '$moments[4]'); 45 | } 46 | 47 | done_testing(); 48 | 49 | -------------------------------------------------------------------------------- /t/Util.pm: -------------------------------------------------------------------------------- 1 | package Util; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Carp qw[]; 7 | use Test::Fatal qw[exception lives_ok]; 8 | 9 | BEGIN { 10 | our @EXPORT_OK = qw[ throws_ok warns_ok lives_ok ]; 11 | our %EXPORT_TAGS = ( 12 | all => [ @EXPORT_OK ], 13 | ); 14 | 15 | require Exporter; 16 | *import = \&Exporter::import; 17 | } 18 | 19 | my $Tester; 20 | sub throws_ok (&$;$) { 21 | my ($code, $regexp, $name) = @_; 22 | 23 | require Test::Builder; 24 | $Tester ||= Test::Builder->new; 25 | 26 | my $e = exception(\&$code); 27 | my $ok = ($e && $e =~ m/$regexp/); 28 | 29 | $Tester->ok($ok, $name); 30 | 31 | unless ($ok) { 32 | if ($e) { 33 | $Tester->diag("expecting: " . $regexp); 34 | $Tester->diag("found: " . $e); 35 | } 36 | else { 37 | $Tester->diag("expected an exception but none was raised"); 38 | } 39 | } 40 | } 41 | 42 | sub warns_ok (&$;$) { 43 | my ($code, $regexp, $name) = @_; 44 | 45 | require Test::Builder; 46 | $Tester ||= Test::Builder->new; 47 | 48 | my @warnings = (); 49 | local $SIG{__WARN__} = sub { push @warnings, @_ }; 50 | 51 | my $e = exception(\&$code); 52 | my $ok = (!$e && @warnings == 1 && $warnings[0] =~ m/$regexp/); 53 | 54 | $Tester->ok($ok, $name); 55 | 56 | unless ($ok) { 57 | if ($e) { 58 | $Tester->diag("expected a warning but an exception was raised"); 59 | $Tester->diag("exception: " . $e); 60 | } 61 | elsif (@warnings == 0) { 62 | $Tester->diag("expected a warning but none were issued"); 63 | } 64 | elsif (@warnings >= 2) { 65 | $Tester->diag("expected a warning but several were issued"); 66 | $Tester->diag("warnings: " . join '', @warnings); 67 | } 68 | else { 69 | $Tester->diag("expecting: " . $regexp); 70 | $Tester->diag("found: " . $warnings[0]); 71 | } 72 | } 73 | } 74 | 75 | 1; 76 | 77 | -------------------------------------------------------------------------------- /typemap: -------------------------------------------------------------------------------- 1 | TYPEMAP 2 | I64V T_I64V 3 | 4 | moment_t T_MOMENT 5 | const moment_t T_MOMENT 6 | 7 | moment_t * T_MOMENT_PTR 8 | const moment_t * T_MOMENT_PTR 9 | 10 | 11 | INPUT 12 | T_I64V 13 | $var = SvI64V($arg); 14 | 15 | T_MOMENT 16 | $var = sv_2moment($arg, \"$var\"); 17 | 18 | T_MOMENT_PTR 19 | $var = sv_2moment_ptr($arg, \"$var\"); 20 | 21 | OUTPUT 22 | T_I64V 23 | $arg = newSVi64v($var); 24 | 25 | T_MOMENT 26 | $arg = newSVmoment(&$var, stash); 27 | 28 | --------------------------------------------------------------------------------