File Coverage

blib/lib/DateTime/Format/EraLegis.pm
Criterion Covered Total %
statement 164 181 90.6
branch 56 94 59.5
condition 9 15 60.0
subroutine 30 33 90.9
pod 0 3 0.0
total 259 326 79.4


line stmt bran cond sub pod time code
1             package DateTime::Format::EraLegis;
2             $DateTime::Format::EraLegis::VERSION = '0.012';
3             # ABSTRACT: DateTime formatter for Era Legis (http://oto-usa.org/calendar.html)
4              
5 1     1   811470 use 5.014;
  1         4  
6 1     1   707 use Function::Parameters qw(fun method);
  1         4257  
  1         7  
7 1     1   1295 use Moo;
  1         8526  
  1         7  
8 1     1   2395 use strictures 2;
  1         1937  
  1         73  
9 1     1   217 use namespace::clean;
  1         3  
  1         15  
10 1     1   1141 use Astro::Sunrise qw(sunrise);
  1         20897  
  1         232  
11              
12             has 'ephem' => (
13             is => 'ro',
14             # isa => 'DateTime::Format::EraLegis::Ephem',
15             lazy => 1,
16             builder => 1,
17             );
18              
19             has 'style' => (
20             is => 'ro',
21             # isa => 'DateTime::Format::EraLegis::Style',
22             lazy => 1,
23             builder => 1,
24             );
25              
26 0 0   0   0 method _build_ephem() {
  0 0       0  
  0         0  
  0         0  
27 0         0 return DateTime::Format::EraLegis::Ephem::DBI->new;
28             }
29              
30 0 0   0   0 method _build_style() {
  0 0       0  
  0         0  
  0         0  
31 0         0 return DateTime::Format::EraLegis::Style->new;
32             }
33              
34 22 50 66 22 0 49782 method format_datetime($dt, :$format = 'plain', :$geo = undef) {
  22 50       111  
  22 100       41  
  22 50       72  
  22         70  
  22         41  
  22         60  
  22         36  
35 22         67 $dt = $dt->clone;
36              
37             ### Day of week should match existing time zone
38 22         293 my $dow = $dt->day_of_week;
39              
40             ### Adjust $dow based on sunrise time
41 22         82 my $sunrise = '06:00:00'; # default to 6am sunrise
42 22 100       54 if ($geo) {
43 2         9 ($sunrise, undef) = sunrise(
44             { year => $dt->year
45             , month => $dt->month
46             , day => $dt->day
47             , lat => $geo->[0]
48             , lon => $geo->[1]
49             , tz => ($dt->offset / 3600)
50             , precise => 1
51             }
52             );
53 2         2240 $sunrise .= ':00';
54             }
55 22 100       60 if ($dt->hms lt $sunrise) {
56 14 100       294 $dow = $dow == 1 ? 7 : $dow - 1;
57             }
58              
59 22         157 my %tdate = (
60             evdate_local => $dt->ymd . ' ' . $dt->hms,
61             dow => $dow,
62             sunrise => $sunrise,
63             is_dst => $dt->is_dst,
64             tz_offset => $dt->offset,
65             );
66              
67             ### But pull ephemeris data based on UTC
68 22         3024 $dt->set_time_zone('UTC');
69 22         4546 $tdate{evdate_utc} = $dt->ymd . ' ' . $dt->hms;
70              
71 22         475 for ( qw(sol luna) ) {
72 44         1117 my $deg = $self->ephem->lookup( $_, $dt );
73 44         240 $tdate{$_}{sign} = int($deg / 30);
74 44         138 $tdate{$_}{deg} = int($deg % 30);
75             }
76              
77             my $years = $dt->year -
78 22 100 100     90 (($dt->month <= 3 && $tdate{sol}{sign} > 0) ? 1905 : 1904);
79 22         311 $tdate{year} = [ int( $years/22 ), int( $years%22 ) ];
80              
81 22         551 $tdate{plain} = $self->style->express( \%tdate );
82              
83 22 100       199 return ($format eq 'raw') ? \%tdate : $tdate{plain};
84             }
85              
86             ######################################################
87             package DateTime::Format::EraLegis::Ephem;
88 1     1   1509 use Moo::Role;
  1         4434  
  1         10  
89 1     1   489 use strictures 2;
  1         21  
  1         52  
90              
91             requires 'lookup';
92              
93             ######################################################
94             package DateTime::Format::EraLegis::Ephem::DBI;
95             $DateTime::Format::EraLegis::Ephem::DBI::VERSION = '0.012';
96 1     1   305 use 5.010;
  1         5  
97 1     1   12 use Function::Parameters qw(fun method);
  1         3  
  1         9  
98 1     1   598 use Moo;
  1         3  
  1         9  
99 1     1   342 use strictures 2;
  1         6  
  1         37  
100 1     1   164 use namespace::clean;
  1         3  
  1         12  
101 1     1   296 use Carp;
  1         3  
  1         83  
102 1     1   7 use DBI;
  1         2  
  1         298  
103              
104             with 'DateTime::Format::EraLegis::Ephem';
105              
106             has 'ephem_db' => (
107             is => 'ro',
108             # isa => 'Str',
109             builder => 1,
110             lazy => 1,
111             );
112              
113             has 'dbh' => (
114             is => 'ro',
115             # isa => 'DBI::db',
116             builder => 1,
117             lazy => 1,
118             );
119              
120 0 0   0   0 method _build_ephem_db() {
  0 0       0  
  0         0  
  0         0  
121             return $ENV{ERALEGIS_EPHEMDB}
122 0   0     0 // croak 'No ephemeris database defined';
123             }
124              
125 1 50   1   14 method _build_dbh() {
  1 50       5  
  1         2  
  1         2  
126 1         35 return DBI->connect( 'dbi:SQLite:dbname='.$self->ephem_db );
127             }
128              
129 44 50   44 0 432 method lookup($body, $dt) {
  44 50       95  
  44         81  
  44         106  
  44         60  
130 44         122 my $time = $dt->ymd . ' ' . $dt->hms;
131 44 50       980 croak 'Date is before era legis' if $time lt '1904-03-20';
132 44         803 my $rows = $self->dbh->selectcol_arrayref(
133             q{SELECT degree FROM ephem
134             WHERE body = ? AND time < ?
135             ORDER BY time DESC LIMIT 1},
136             undef, $body, $time );
137 44 50       12360 croak "Cannot find date entry for $time." unless $rows;
138              
139 44         155 return $rows->[0];
140             }
141              
142             ######################################################
143              
144             package DateTime::Format::EraLegis::Style;
145              
146 1     1   435 use 5.010;
  1         5  
147 1     1   6 use Function::Parameters qw(fun method);
  1         2  
  1         5  
148 1     1   524 use Moo;
  1         2  
  1         6  
149 1     1   355 use strictures 2;
  1         6  
  1         43  
150 1     1   207 use namespace::clean;
  1         3  
  1         6  
151 1     1   273 use utf8;
  1         2  
  1         11  
152 1     1   800 use Roman::Unicode qw(to_roman);
  1         42040  
  1         444  
153              
154             has 'lang' => (
155             is => 'ro',
156             # isa => 'Str',
157             default => 'latin',
158             required => 1,
159             );
160              
161             has 'dow' => (
162             is => 'ro',
163             # isa => 'ArrayRef',
164             builder => 1,
165             lazy => 1,
166             );
167              
168             has 'signs' => (
169             is => 'ro',
170             # isa => 'ArrayRef',
171             builder => 1,
172             lazy => 1,
173             );
174              
175             has 'years' => (
176             is => 'ro',
177             # isa => 'ArrayRef',
178             builder => 1,
179             lazy => 1,
180             );
181              
182             has 'show_terse' => (
183             is => 'ro',
184             # isa => 'Bool',
185             default => 0,
186             );
187              
188             has [ qw( show_deg show_dow show_year roman_year ) ] => (
189             is => 'ro',
190             # isa => 'Bool',
191             default => 1,
192             );
193              
194             has 'template' => (
195             is => 'ro',
196             # isa => 'Str',
197             builder => 1,
198             lazy => 1,
199             );
200              
201             has 'vs15' => (
202             is => 'ro',
203             # isa => 'Bool',
204             default => 1,
205             );
206              
207 3 50   3   32 method _build_dow() {
  3 50       29  
  3         8  
  3         5  
208             return
209 3 50       39 ($self->lang eq 'symbol')
    100          
210             ? [qw( ☉ ☽ ♂ ☿ ♃ ♀ ♄ ☉ )]
211             : ($self->lang eq 'english')
212             ? [qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday Sunday)]
213             : [qw(Solis Lunae Martis Mercurii Iovis Veneris Saturni Solis)];
214             }
215              
216 5 50   5   5938 method _build_signs() {
  5 50       16  
  5         8  
  5         10  
217 5 100       43 return [qw( ♈ ♉ ♊ ♋ ♌ ♍ ♎ ♏ ♐ ♑ ♒ ♓ )]
218             if $self->lang eq 'symbol';
219              
220 2 50       8 return [qw(Aries Taurus Gemini Cancer Leo Virgo Libra Scorpio Sagittarius Capricorn Aquarius Pisces)]
221             if $self->lang eq 'english';
222              
223 2 50       8 return [qw(Aries Taurus Gemini Cancer Leo Virgo Libra Scorpio Sagittarius Capricorn Aquarius Pisces)]
224             if $self->lang eq 'poor-latin';
225              
226 2 50 33     26 return [qw(Arietis Tauri Geminorum Cancri Leonis Virginis Librae Scorpii Sagittarii Capricorni Aquarii Piscis)]
227             if $self->lang eq 'latin' && $self->show_deg;
228              
229 0         0 return [qw(Ariete Tauro Geminis Cancro Leone Virginie Libra Scorpio Sagittario Capricorno Aquario Pisci)];
230             }
231              
232 4 50   4   36 method _build_years() {
  4 50       10  
  4         8  
  4         6  
233             return
234             ($self->roman_year)
235 4 50       18 ? [ 0, map { to_roman($_) } 1..21 ]
  84         9339  
236             : [ 0..21 ];
237             }
238              
239 5 50   5   45 method _build_template() {
  5 50       14  
  5         9  
  5         7  
240 5         43 my $template = '';
241 5 100       24 my $vs = $self->vs15 ? '︎' : '';
242 5 50       16 if ($self->show_deg) {
243 5         19 $template = "☉$vs in {sdeg}° {ssign} : ☽$vs in {ldeg}° {lsign}";
244             }
245             else {
246 0         0 $template = "☉$vs in {ssign} : ☽$vs in {lsign}";
247             }
248 5 100       16 if ($self->show_terse) {
249 2         15 $template =~ s/ in / /g;
250             }
251 5 100       16 if ($self->show_dow) {
252 3         7 $template .= ' : ';
253 3 100       12 $template .= ($self->lang eq 'latin')
254             ? 'dies '
255             : '';
256 3         7 $template .= '{dow}';
257             }
258 5 100       15 if ($self->show_year) {
259 4         9 $template .= ' : ';
260 4 50       18 $template .= ($self->lang eq 'symbol')
    100          
261             ? '{year1}{year2}'
262             : ($self->lang eq 'english')
263             ? 'Year {year1}.{year2} of the New Aeon'
264             : 'Anno {year1}{year2} æræ legis';
265             }
266              
267 5         20 return $template;
268             }
269              
270 22 50   22 0 268 method express( $tdate ) {
  22 50       50  
  22         38  
  22         41  
  22         33  
271 22         370 my $datestr = $self->template;
272              
273 22 100 100     240 my $vs = $self->lang eq 'symbol' && $self->vs15 ? '︎' : '';
274              
275 22         102 $datestr =~ s/{sdeg}/$tdate->{sol}{deg}/ge;
  22         146  
276 22         89 $datestr =~ s/{ssign}/$self->signs->[$tdate->{sol}{sign}].$vs/ge;
  22         385  
277 22         224 $datestr =~ s/{ldeg}/$tdate->{luna}{deg}/ge;
  22         77  
278 22         60 $datestr =~ s/{lsign}/$self->signs->[$tdate->{luna}{sign}].$vs/ge;
  22         419  
279 22         218 $datestr =~ s/{dow}/$self->dow->[$tdate->{dow}].$vs/ge;
  3         57  
280 22         62 $datestr =~ s/{year1}/$self->years->[$tdate->{year}[0]]/ge;
  21         339  
281 22         757 $datestr =~ s/{year2}/lc($self->years->[$tdate->{year}[1]])/ge;
  21         392  
282              
283 22         6136 return $datestr;
284             }
285              
286             1;
287              
288             __END__
289              
290             =head1 NAME
291              
292             DateTime::Format::EraLegis - DateTime converter for Era Legis
293             DateTime::Format::EraLegis::Ephem - planetary ephemeris role
294             DateTime::Format::EraLegis::Ephem::DBI - default ephemeris getter
295             DateTime::Format::EraLegis::Style - customize output styles
296              
297             =head1 SYNOPSIS
298              
299             use DateTime::Format::EraLegis;
300              
301             my $ephem = DateTime::Format::EraLegis::Ephem::DBI->new(
302             ephem_db => 'db.sqlite3');
303             my $style = DateTime::Format::EraLegis::Style->new(
304             show_terse => 1, lang => 'symbol');
305             my $dtf = DateTime::Format::EraLegis->new(
306             ephem => $ephem, style => $style);
307              
308             my $dt->set_formatter($dtf);
309              
310             =head1 DESCRIPTION
311              
312             These three modules combined enable DateTime objects to emit date strings
313             formatted according to the Thelemic calendar. The ephemeris provides access
314             to the planetary location of the Sun and Moon keyed by UTC timestamp. The
315             style dictates the specific expression of the of datetime value using a
316             template into which one can place tokens which can be converted into the
317             sign/degree coordinates for the given date. A default style exists and is
318             permutable by boolean attributes.
319              
320             All three classes are built with Moose and behave accordingly. Method
321             arguments are typechecked and will die on failure. Defaults exist for
322             all attributes. All attributes are read-only and must be assigned at
323             the time of instantiation.
324              
325             =head1 ATTRIBUTES AND METHODS
326              
327             =over
328              
329             =item *
330              
331             DateTime::Format::EraLegis
332              
333             =over
334              
335             =item *
336              
337             ephem: DT::F::EL::Ephem object. Creates a new DBI one by default.
338              
339             =item *
340              
341             style: DT::F::EL::Style object. Creates a new one by default.
342              
343             =item *
344              
345             format_datetime(DateTime $dt, Str $format): Standard interface for a
346             DateTime::Format package. $format is one of 'plain' or 'raw'.
347             Defaults to 'plain'.
348              
349             =back
350              
351             =item *
352              
353             DateTime::Format::EraLegis::Ephem (Role)
354              
355             =over
356              
357             =item *
358              
359             lookup(Str $body, DateTime $dt): Required by any role consumer. $body
360             is one of "sol" or "luna". $dt is the date in question (in UTC!).
361             Returns the number of degrees away from 0 degrees Aries. Divide by
362             thirty to get the sign. Modulo by thirty to get the degrees of that
363             sign.
364              
365             =back
366              
367             =item *
368              
369             DateTime::Format::EraLegis::Ephem::DBI
370              
371             =over
372              
373             =item *
374              
375             Consumes DT::F::EL::Ephem role.
376              
377             =item *
378              
379             ephem_db: Filename of the sqlite3 ephemeris database. Defaults to the value
380             of $ENV{ERALEGIS_EPHEMDB}.
381              
382             =item *
383              
384             dbh: DBI handle for ephemeris database. Defaults to creating a new one pointing
385             to the ephem_db database.
386              
387             =back
388              
389             =item *
390              
391             DateTime::Format::EraLegis::Style
392              
393             =over
394              
395             =item *
396              
397             template: Assign a custom template value. Variables (enclosed in '{}')
398             include 'ssign' and 'sdeg' for Sol sign and degree, 'lsign' and 'ldeg'
399             for Luna sign and degree, 'dow' for day of the week, and 'year1' and
400             'year2' for the two docosades. Example:
401              
402             "Sol in {sdeg} degrees {ssign}, anno {year1}{year2} era legis"
403              
404             Interpolated values get assigned based on the setting of 'lang'.
405              
406             =item *
407              
408             lang: Set the output language, one of latin, english, symbol, poor-latin.
409             Defaults to 'latin'.
410              
411             =item *
412              
413             show_terse, show_deg, show_dow, show_year, roman_year: Flags to direct
414             the style to alter the default template.
415              
416             =back
417              
418             =back
419              
420             =head1 DATABASE SCHEMA
421              
422             The schema for the DBI ephemeris table is very simple and the querying
423             SQL very generic. Most DBI backends should work without issue, though
424             SQLite3 is the only one tested. The schema is:
425              
426             CREATE TABLE ephem (
427             body TEXT, -- one of 'sol' or 'luna'
428             time DATETIME, -- UTC timestamp of shift into degree
429             degree INTEGER NOT NULL, -- degrees from 0 degrees Aries
430             PRIMARY KEY (body, time)
431             );
432              
433             =head1 BUGS
434              
435             Please report bugs as issues at:
436             https://gitlab.com/clayfouts/datetime-format-eralegis
437              
438             =head1 AUTHOR
439              
440             Clay Fouts <cfouts@khephera.net>
441              
442             =head1 COPYRIGHT & LICENSE
443              
444             Copyright (c) 2012 Clay Fouts
445              
446             This is free software; you can redistribute it and/or modify it under
447             the same terms as the Perl 5 programming language system itself.
448              
449             =cut