File Coverage

blib/lib/Calendar/Gregorian.pm
Criterion Covered Total %
statement 17 47 36.1
branch 0 10 0.0
condition 0 6 0.0
subroutine 6 13 46.1
pod 4 7 57.1
total 27 83 32.5


line stmt bran cond sub pod time code
1             package Calendar::Gregorian;
2              
3             $Calendar::Gregorian::VERSION = '0.13';
4             $Calendar::Gregorian::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Calendar::Gregorian - Interface to Gregorian Calendar.
9              
10             =head1 VERSION
11              
12             Version 0.13
13              
14             =cut
15              
16 4     4   27548 use 5.006;
  4         9  
17 4     4   2048 use Data::Dumper;
  4         25390  
  4         186  
18              
19 4     4   1643 use Date::Gregorian::Simple;
  4         279594  
  4         122  
20 4     4   25 use Moo;
  4         4  
  4         11  
21 4     4   669 use namespace::clean;
  4         5  
  4         13  
22 4     4   488 use overload q{""} => 'as_string', fallback => 1;
  4         7  
  4         22  
23              
24             has year => (is => 'rw', predicate => 1);
25             has month => (is => 'rw', predicate => 1);
26             has date => (is => 'ro', default => sub { Date::Gregorian::Simple->new });
27             with 'Calendar::Plugin::Renderer';
28              
29             sub BUILD {
30 0     0 0   my ($self) = @_;
31              
32 0 0         $self->date->validate_year($self->year) if $self->has_year;
33 0 0         $self->date->validate_month($self->month) if $self->has_month;
34              
35 0 0 0       unless ($self->has_year && $self->has_month) {
36 0           $self->year($self->date->year);
37 0           $self->month($self->date->month);
38             }
39             }
40              
41             =head1 DESCRIPTION
42              
43             Simple Gregorian Calendar interface.
44              
45             +-----------------------------------------------------------------------------------+
46             | March [2016 BE] |
47             +-----------+-----------+-----------+-----------+-----------+-----------+-----------+
48             | Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday |
49             +-----------+-----------+-----------+-----------+-----------+-----------+-----------+
50             | | 1 | 2 | 3 | 4 | 5 |
51             +-----------+-----------+-----------+-----------+-----------+-----------+-----------+
52             | 6 | 7 | 8 | 9 | 10 | 11 | 12 |
53             +-----------+-----------+-----------+-----------+-----------+-----------+-----------+
54             | 13 | 14 | 15 | 16 | 17 | 18 | 19 |
55             +-----------+-----------+-----------+-----------+-----------+-----------+-----------+
56             | 20 | 21 | 22 | 23 | 24 | 25 | 26 |
57             +-----------+-----------+-----------+-----------+-----------+-----------+-----------+
58             | 27 | 28 | 29 | 30 | 31 | |
59             +-----------+-----------+-----------+-----------+-----------+-----------+-----------+
60              
61             The package L provides command line tool C to display the
62             supported calendars on the terminal.
63              
64             =head1 SYNOPSIS
65              
66             use strict; use warnings;
67             use Calendar::Gregorian;
68              
69             # prints current gregorian month calendar.
70             print Calendar::Gregorian->new, "\n";
71             print Calendar::Gregorian->new->current, "\n";
72              
73             # prints gregorian month calendar for the first month of year 2016.
74             print Calendar::Gregorian->new({ month => 1, year => 2016 }), "\n";
75              
76             # prints gregorian month calendar in which the given julian date falls in.
77             print Calendar::Gregorian->new->from_julian(2457102.5), "\n";
78              
79             # prints current month gregorian calendar in SVG format.
80             print Calendar::Gregorian->new->as_svg;
81              
82             # prints current month gregorian calendar in text format.
83             print Calendar::Gregorian->new->as_text;
84              
85             =head1 GREGORIAN MONTHS
86              
87             +--------+------------------------------------------------------------------+
88             | Number | Name |
89             +--------+------------------------------------------------------------------+
90             | 1 | January |
91             | 2 | February |
92             | 3 | March |
93             | 4 | April |
94             | 5 | May |
95             | 6 | June |
96             | 7 | July |
97             | 8 | August |
98             | 9 | September |
99             | 10 | October |
100             | 11 | November |
101             | 12 | December |
102             +--------+------------------------------------------------------------------+
103              
104             =head1 GREGORIAN DAYS
105              
106             +---------------------------------------------------------------------------+
107             | English Name |
108             +---------------------------------------------------------------------------+
109             | Sunday |
110             | Monday |
111             | Tuesday |
112             | Wednesday |
113             | Thursday |
114             | Friday |
115             | Saturday |
116             +---------------------------------------------------------------------------+
117              
118             =head1 METHODS
119              
120             =head2 current()
121              
122             Returns current month of the Gregorian calendar.
123              
124             =cut
125              
126             sub current {
127 0     0 1   my ($self) = @_;
128              
129 0           return $self->as_text($self->date->month, $self->date->year);
130             }
131              
132             =head2 from_julian($julian_date)
133              
134             Returns Gregorian month calendar in which the given julian date falls in.
135              
136             =cut
137              
138             sub from_julian {
139 0     0 1   my ($self, $julian) = @_;
140              
141 0           my $date = $self->date->from_julian($julian);
142 0           return $self->as_text($date->month, $date->year);
143             }
144              
145             =head2 as_svg($month, $year)
146              
147             Returns calendar for the given C<$month> and C<$year> rendered in SVG format. If
148             C<$month> and C<$year> missing, it would return current calendar month.
149              
150             =cut
151              
152             sub as_svg {
153 0     0 1   my ($self, $month, $year) = @_;
154              
155 0           ($month, $year) = $self->validate_params($month, $year);
156 0           my $date = Date::Gregorian::Simple->new({ year => $year, month => $month, day => 1 });
157              
158 0           return $self->svg_calendar(
159             {
160             start_index => $date->day_of_week,
161             month_name => $date->months->[$month],
162             days => $date->days_in_month_year($month, $year),
163             year => $year
164             });
165             }
166              
167             =head2 as_text($month, $year)
168              
169             Returns color coded Gregorian calendar for the given C<$month> and C<$year>. If
170             C<$month> and C<$year> missing, it would return current calendar month.
171              
172             =cut
173              
174             sub as_text {
175 0     0 1   my ($self, $month, $year) = @_;
176              
177 0           ($month, $year) = $self->validate_params($month, $year);
178 0           my $date = Date::Gregorian::Simple->new({ year => $year, month => $month, day => 1 });
179              
180 0           return $self->text_calendar(
181             {
182             start_index => $date->day_of_week,
183             month_name => $date->get_month_name,
184             days => $date->days_in_month_year($month, $year),
185             day_names => $date->days,
186             year => $year
187             });
188             }
189              
190             sub as_string {
191 0     0 0   my ($self) = @_;
192              
193 0           return $self->as_text($self->month, $self->year);
194             }
195              
196             #
197             #
198             # PRIVATE METHODS
199              
200             sub validate_params {
201 0     0 0   my ($self, $month, $year) = @_;
202              
203 0 0 0       if (defined $month && defined $year) {
204 0           $self->date->validate_month($month);
205 0           $self->date->validate_year($year);
206              
207 0 0         if ($month !~ /^\d+$/) {
208 0           $month = $self->date->get_month_number($month);
209             }
210             }
211             else {
212 0           $month = $self->month;
213 0           $year = $self->year;
214             }
215              
216 0           return ($month, $year);
217             }
218              
219             =head1 AUTHOR
220              
221             Mohammad S Anwar, C<< >>
222              
223             =head1 REPOSITORY
224              
225             L
226              
227             =head1 SEE ALSO
228              
229             =over 4
230              
231             =item L
232              
233             =item L
234              
235             =item L
236              
237             =item L
238              
239             =back
240              
241             =head1 BUGS
242              
243             Please report any bugs / feature requests to C
244             or through the web interface at L.
245             I will be notified, and then you'll automatically be notified of progress on your
246             bug as I make changes.
247              
248             =head1 SUPPORT
249              
250             You can find documentation for this module with the perldoc command.
251              
252             perldoc Calendar::Gregorian
253              
254             You can also look for information at:
255              
256             =over 4
257              
258             =item * RT: CPAN's request tracker
259              
260             L
261              
262             =item * AnnoCPAN: Annotated CPAN documentation
263              
264             L
265              
266             =item * CPAN Ratings
267              
268             L
269              
270             =item * Search CPAN
271              
272             L
273              
274             =back
275              
276             =head1 LICENSE AND COPYRIGHT
277              
278             Copyright (C) 2016 Mohammad S Anwar.
279              
280             This program is free software; you can redistribute it and / or modify it under
281             the terms of the the Artistic License (2.0). You may obtain a copy of the full
282             license at:
283              
284             L
285              
286             Any use, modification, and distribution of the Standard or Modified Versions is
287             governed by this Artistic License.By using, modifying or distributing the Package,
288             you accept this license. Do not use, modify, or distribute the Package, if you do
289             not accept this license.
290              
291             If your Modified Version has been derived from a Modified Version made by someone
292             other than you,you are nevertheless required to ensure that your Modified Version
293             complies with the requirements of this license.
294              
295             This license does not grant you the right to use any trademark, service mark,
296             tradename, or logo of the Copyright Holder.
297              
298             This license includes the non-exclusive, worldwide, free-of-charge patent license
299             to make, have made, use, offer to sell, sell, import and otherwise transfer the
300             Package with respect to any patent claims licensable by the Copyright Holder that
301             are necessarily infringed by the Package. If you institute patent litigation
302             (including a cross-claim or counterclaim) against any party alleging that the
303             Package constitutes direct or contributory patent infringement,then this Artistic
304             License to you shall terminate on the date that such litigation is filed.
305              
306             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
307             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
308             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
309             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
310             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
311             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
312             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
313              
314             =cut
315              
316             1; # End of Calendar::Gregorian