File Coverage

blib/lib/Date/Extract/P800Picture.pm
Criterion Covered Total %
statement 48 48 100.0
branch 6 6 100.0
condition n/a
subroutine 12 12 100.0
pod 1 1 100.0
total 67 67 100.0


line stmt bran cond sub pod time code
1             # -*- cperl; cperl-indent-level: 4 -*-
2             # Copyright (C) 2008-2020, Roland van Ipenburg
3             package Date::Extract::P800Picture v1.1.6;
4              
5 8     8   1449905 use strict;
  8         83  
  8         244  
6 8     8   43 use warnings;
  8         17  
  8         208  
7              
8 8     8   43 use utf8;
  8         16  
  8         78  
9 8     8   342 use 5.014000;
  8         29  
10              
11 8     8   5108 use Moose;
  8         3901517  
  8         61  
12              
13 8     8   62856 use POSIX ();
  8         21  
  8         298  
14 8     8   6705 use English qw( -no_match_vars);
  8         32737  
  8         56  
15 8     8   10059 use DateTime ();
  8         3520078  
  8         448  
16              
17 8     8   4602 use Date::Extract::P800Picture::Exceptions ();
  8         27  
  8         193  
18              
19 8     8   4797 use Readonly ();
  8         33570  
  8         5156  
20             ## no critic (ProhibitCallsToUnexportedSubs)
21             Readonly::Scalar my $EPOCH_YEAR => 2000;
22             Readonly::Scalar my $MONTHS_IN_YEAR => 12;
23             Readonly::Scalar my $MAX_DAYS_IN_MONTH => 31;
24             Readonly::Scalar my $HOURS_IN_DAY => 24;
25             Readonly::Scalar my $BASE_N => 36;
26             Readonly::Scalar my $TZ => 'UTC';
27             Readonly::Hash my %ERR => (
28             'MISSING_DATE' => q{No date found in filename '%s'},
29             'MISSING_FILENAME' => q{Filename is not set, nothing to extract},
30             );
31             ## use critic
32              
33             ## no critic (ProhibitComplexRegexes)
34             my $PATTERN = qr{
35             ^
36             (?<year> [[:alnum:]] ) # max 36 years: $EPOCH_YEAR 2000 to 2035
37             (?<month> [[:digit:]AB] ) # max 12 months
38             (?<day> [[:digit:]A-U]) # max 31 days
39             (?<hour> [[:digit:]A-N]) # max 24 hours: 0 to 23
40             (?<serial> [[:digit:]]{4}) # max unique up to 10000 pictures per hour
41             (?<suffix> [.]JPG ) # JPEG extension
42             $
43             }aixsm;
44             ## use critic
45              
46             ## no critic qw(ProhibitCallsToUndeclaredSubs)
47             has 'filename' => (
48             ## use critic
49             'is' => 'rw',
50             'isa' => 'Str',
51             );
52              
53             ## no critic qw(ProhibitCallsToUndeclaredSubs)
54             has 'datetime' => (
55             ## use critic
56             'is' => 'rw',
57             'isa' => 'DateTime',
58             'default' => sub {
59             DateTime->new(
60             'year' => $EPOCH_YEAR,
61             'time_zone' => $TZ,
62             );
63             },
64             );
65              
66             sub extract {
67 2454     2454 1 1754305 my ( $self, $filename ) = @_;
68 2454 100       97511 ( defined $filename ) && $self->filename($filename);
69 2454 100       71998 if ( defined $self->filename ) {
70 2453         69753 $self->filename =~ $PATTERN;
71             my ( $year, $month, $day, $hour ) = (
72             $LAST_PAREN_MATCH{'year'}, $LAST_PAREN_MATCH{'month'},
73 2453         29151 $LAST_PAREN_MATCH{'day'}, $LAST_PAREN_MATCH{'hour'},
74             );
75              
76 2453 100       9016 if ( defined $year ) {
77 2449         7850 $self->_parse( \$year, $BASE_N );
78 2449         6892 $self->_parse( \$month, $MONTHS_IN_YEAR );
79 2449         6828 $self->_parse( \$day, $MAX_DAYS_IN_MONTH );
80 2449         6470 $self->_parse( \$hour, $HOURS_IN_DAY );
81 2449         77689 $self->datetime->set(
82             'year' => $year + $EPOCH_YEAR,
83             'month' => $month + 1,
84             'day' => $day + 1,
85             'hour' => $hour,
86             );
87             }
88             else {
89             ## no critic (RequireExplicitInclusion)
90             DateExtractP800PictureException->throw(
91             ## use critic
92 4         123 'error' => sprintf $ERR{'MISSING_DATE'},
93             $self->filename,
94             );
95             }
96             }
97             else {
98             ## no critic (RequireExplicitInclusion)
99             DateExtractP800PictureException->throw(
100             ## use critic
101 1         22 'error' => $ERR{'MISSING_FILENAME'},
102             );
103             }
104 2442         1259785 return $self->datetime;
105             }
106              
107             # Converts a character to a number given base. Changes the referenced part.
108              
109             sub _parse {
110 9796     9796   16551 my ( $self, $sr_part, $base ) = @_;
111 9796         13540 my $n_unparsed = 0;
112              
113             ## no critic (ProhibitCallsToUnexportedSubs)
114 9796         13936 return ( ${$sr_part}, $n_unparsed ) = POSIX::strtol( ${$sr_part}, $base );
  9796         18586  
  9796         21541  
115             ## use critic
116             }
117              
118             1;
119              
120             __END__
121              
122             =encoding utf8
123              
124             =for stopwords Bitbucket Ericsson Filename MERCHANTABILITY POSIX filename timestamp jpg JPG
125             YMDH DateTime undef perl Readonly P800 P900 P910 perls Ipenburg
126              
127             =head1 NAME
128              
129             Date::Extract::P800Picture - extract the date from Sony Ericsson P800 pictures
130              
131             =head1 VERSION
132              
133             This document describes Date::Extract::P800Picture version C<v1.1.6>.
134              
135             =head1 SYNOPSIS
136              
137             use Date::Extract::P800Picture;
138              
139             $filename = "8B360001.JPG"; # 2008-12-04T6:00:00
140              
141             $parser = new Date::Extract::P800Picture();
142             $parser = new Date::Extract::P800Picture('filename' => $filename);
143              
144             $datetime = $parser->extract();
145             $datetime = $parser->extract($filename);
146              
147             =head1 DESCRIPTION
148              
149             The Sony Ericsson L<P800|https://en.wikipedia.org/wiki/Sony_Ericsson_P800>,
150             L<P900|https://en.wikipedia.org/wiki/Sony_Ericsson_P900> and
151             L<P910|https://en.wikipedia.org/wiki/Sony_Ericsson_P910> camera phones store
152             pictures taken with the camera on the device with a filename consisting of the
153             date and the hour the picture was taken, followed by a four digit number and
154             the .JPG extension. The format of the date and the hour is YMDH, in which the
155             single characters are base 36 to fit a range of about 36 years, 12 months, 31
156             days and 24 hours since the year 2000 in a case insensitive US-ASCII
157             representation.
158              
159             A L<web implementation of this parser|https://rolandvanipenburg.com/p800/> can
160             be used without installing this module.
161              
162             =head1 SUBROUTINES/METHODS
163              
164             =over 4
165              
166             =item Date::Extract::P800Picture-E<gt>new()
167              
168             =item Date::Extract::P800Picture-E<gt>new('filename' => $filename)
169              
170             Constructs a new Date::Extract::P800Picture object.
171              
172             =item $parser->filename($filename);
173              
174             Sets the filename to extract the date and hour from.
175              
176             =item $obj-E<gt>extract()
177              
178             Extract date and hour from the string and returns it as L<DateTime|DateTime>
179             object. Returns undef if no valid date could be extracted.
180              
181             =back
182              
183             =head1 CONFIGURATION AND ENVIRONMENT
184              
185             No configuration and environment settings are used.
186              
187             =head1 DEPENDENCIES
188              
189             =over 4
190              
191             =item * perl 5.14
192              
193             =item * L<POSIX|POSIX>
194              
195             =item * L<English|English>
196              
197             =item * L<DateTime|DateTime>
198              
199             =item * L<Readonly|Readonly>
200              
201             =item * L<Moose|Moose>
202              
203             =item * L<Test::More|Test::More>
204              
205             =back
206              
207             =head1 INCOMPATIBILITIES
208              
209             =over 4
210              
211             =item * To avoid ambiguity between more common date notations and the
212             Sony Ericsson P800's date notation this is a separate module. It's highly
213             unlikely that in any other setting "2000" means the first of January 2002.
214              
215             =item * For perls earlier than 5.14 version 0.04 of this module provides the
216             same functionality in a perl 5.6 compatible way.
217              
218             =back
219              
220             =head1 DIAGNOSTICS
221              
222             An exception in the form of an L<Exception::Class|Exception::Class> named
223             C<DateExtractP800PictureException> is thrown when a date can not be extracted
224             from the string:
225              
226             =over 4
227              
228             =item * No date found in filename '%s'
229              
230             =item * Filename is not set, nothing to extract
231              
232             =back
233              
234             =head1 BUGS AND LIMITATIONS
235              
236             =over 4
237              
238             =item * The date could be from another timezone, based on the device settings
239             and when and where the picture was taken.
240              
241             =item * Usually the files are transferred from the P800 to other systems in a
242             way that has not completely preserved the timestamp of the file, so there is
243             no reliable way to double check the results by comparing the date extracted
244             from the filename with the timestamp of the file.
245              
246             =item * There are no error values to provide different exit statuses for
247             different failure reasons
248              
249             =back
250              
251             Please report any bugs or feature requests at
252             L<Bitbucket|
253             https://bitbucket.org/rolandvanipenburg/date-extract-p800picture/issues>.
254              
255             =head1 AUTHOR
256              
257             Roland van Ipenburg, E<lt>roland@rolandvanipenburg.comE<gt>
258              
259             =head1 LICENSE AND COPYRIGHT
260              
261             Copyright (C) 2008-2021, Roland van Ipenburg
262              
263             This library is free software; you can redistribute it and/or modify
264             it under the same terms as Perl itself, either Perl version 5.14.0 or,
265             at your option, any later version of Perl 5 you may have available.
266              
267             =head1 DISCLAIMER OF WARRANTY
268              
269             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
270             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
271             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
272             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
273             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
274             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
275             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
276             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
277             NECESSARY SERVICING, REPAIR, OR CORRECTION.
278              
279             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
280             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
281             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
282             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
283             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
284             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
285             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
286             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
287             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
288             SUCH DAMAGES.
289              
290             =cut