File Coverage

blib/lib/Sculptor/Date.pm
Criterion Covered Total %
statement 31 33 93.9
branch 2 4 50.0
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 42 46 91.3


line stmt bran cond sub pod time code
1             package Sculptor::Date;
2              
3 7     7   221523 use Exporter 'import';
  7         19  
  7         802  
4             @EXPORT_OK = qw(date_to_number number_to_date);
5              
6 7     7   43 use strict;
  7         16  
  7         244  
7 7     7   37 use warnings;
  7         16  
  7         200  
8 7     7   58 use Carp;
  7         14  
  7         536  
9 7     7   6767 use Date::Calc qw/Add_Delta_Days Delta_Days/;
  7         325691  
  7         3190  
10              
11             =head1 NAME
12              
13             Sculptor::Date - Convert Sculptor 4GL dates
14              
15             =head1 VERSION
16              
17             Version 0.02
18              
19             =cut
20              
21             our $VERSION = '0.02';
22              
23              
24              
25             =head1 SYNOPSIS
26              
27             This module converts between ISO dates and Sculptor 4GL day numbers. It has
28             been tested with dates from Sculptor Release 2.5b.
29              
30             Sculptor 4GL is a programming language owned by MPD. For more information on
31             Sculptor, you can visit http://www.sculptor.co.uk/
32              
33              
34             use Sculptor::Date qw/date_to_number number_to_date/;
35              
36             my $date = '2010-01-30';
37              
38             my $day_number = date_to_number($date);
39              
40             my $new_date = number_to_date($day_number);
41              
42              
43             =head1 EXPORT
44              
45             date_to_number, number_to_date
46              
47              
48             =head1 FUNCTIONS
49              
50              
51              
52             =head2 date_to_number
53              
54             Converts an ISO 8601 date (YYYY-MM-DD) to a Sculptor day number.
55              
56             =cut
57              
58             sub date_to_number {
59              
60 6     6 1 34 my $date = shift;
61            
62 6 50       165 if ( $date =~ /\d\d\d\d-\d\d-\d\d/ ) {
63              
64 6         36 my ($y,$m,$d) = split /-/, $date;
65 6         18 my @start = (1970,1,1);
66 6         39 my $delta = Delta_Days($start[0],$start[1],$start[2],$y,$m,$d);
67 6         451 my $japfirst = 719163;
68 6         10 my $dayno = $japfirst + $delta;
69            
70 6         37 return $dayno;
71             }
72              
73 0         0 confess "Malformed date provided to subroutine: [$date].";
74              
75             }
76              
77              
78              
79             =head2 number_to_date
80              
81             Converts a Sculptor day number to an ISO date.
82              
83             =cut
84              
85             sub number_to_date {
86              
87 6     6 1 33 my $sculptor_date = shift;
88            
89 6 50       51 unless ( $sculptor_date =~ m/^\d{1,6}$/ ) {
90 0         0 croak "Incorrect or implausible day number [$sculptor_date].";
91             }
92            
93 6         16 my @start = (1970,1,1);
94 6         12 my $sculptor_first = 719163;
95 6         12 my $diff = $sculptor_date - $sculptor_first;
96 6         34 my @date = Add_Delta_Days(@start,$diff);
97 6         459 my $date = sprintf("%04d-%02d-%02d", @date);
98            
99 6         41 return $date;
100              
101             }
102              
103              
104              
105             =head1 AUTHOR
106              
107             Damon Allen Davison, C<< >>
108              
109              
110              
111             =head1 BUGS
112              
113             Please report any bugs or feature requests to
114             C,
115             or through the web interface at
116             L.
117             I will be notified, and then you'll automatically be notified of progress on
118             your bug as I make changes.
119              
120              
121              
122             =head1 SUPPORT
123              
124             You can find documentation for this module with the perldoc command.
125              
126             perldoc Sculptor::Date
127              
128              
129             You can also look for information at:
130              
131             =over 4
132              
133             =item * RT: CPAN's request tracker
134              
135             L
136              
137             =item * AnnoCPAN: Annotated CPAN documentation
138              
139             L
140              
141             =item * CPAN Ratings
142              
143             L
144              
145             =item * Search CPAN
146              
147             L
148              
149             =back
150              
151              
152              
153             =head1 COPYRIGHT & LICENSE
154              
155             Copyright 2010 Damon Allen Davison, all rights reserved.
156              
157             This program is free software; you can redistribute it and/or modify it
158             under the same terms as Perl itself.
159              
160              
161             =cut
162              
163             1; # End of Sculptor::Date