File Coverage

blib/lib/Media/DateTime/JPEG.pm
Criterion Covered Total %
statement 35 38 92.1
branch 8 10 80.0
condition n/a
subroutine 10 10 100.0
pod 2 2 100.0
total 55 60 91.6


line stmt bran cond sub pod time code
1             package Media::DateTime::JPEG;
2              
3             # ABSTRACT: A plugin for the C module to support JPEG files
4              
5 3     3   6746 use strict;
  3         10  
  3         139  
6 3     3   22 use warnings;
  3         11  
  3         200  
7              
8             our $VERSION = '0.48';
9              
10 3     3   20 use Carp;
  3         10  
  3         487  
11 3     3   11345 use Image::ExifTool;
  3         214137  
  3         306  
12 3     3   36 use DateTime;
  3         7  
  3         71  
13 3     3   16 use Try::Tiny;
  3         6  
  3         1276  
14              
15             my $exifTool;
16              
17             sub datetime {
18 8     8 1 15 my ( $self, $f ) = @_;
19              
20 8 100       50 $exifTool = Image::ExifTool->new() unless $exifTool;
21 8 100       73411 $exifTool->ExtractInfo($f) or do {
22 2         88861 warn "Exiftool unable to read: $f\nFallback to file timestamp.\n";
23 2         39 return;
24             };
25              
26             my $datetime = $exifTool->GetValue('DateTimeOriginal')
27 6 100       189036 or do {
28 2         216 warn "JPEG does not contain DateTimeOriginal exif entry ($f),\n"
29             . "Fallback to file timestamp.\n";
30 2         11 return;
31             };
32              
33             # DateTime format = yyyy:mm:dd hh:mm:ss
34             my ( $y, $m, $d, $h, $min, $s ) = $datetime =~ m/
35             (\d{4}) : # year
36             (\d{2}) : # month
37             (\d{2}) # day
38             \s # space
39             (\d{2}) : # hour
40             (\d{2}) : # min
41             (\d{2}) # sec
42             /x
43 4 50       626 or do {
44 0         0 warn "failed DateTime pattern match in $f\n"
45             . "Fallback to file timestamp";
46 0         0 return;
47             };
48              
49             my $date = try {
50 4     4   246 DateTime->new(
51             year => $y,
52             month => $m,
53             day => $d,
54             hour => $h,
55             minute => $min,
56             second => $s,
57             );
58             }
59             catch {
60 2 50   2   1589 if (/to DateTime::new did not pass/) {
61 2         260 warn
62             "JPEG's DateTimeOriginal exif entry ($f) not a valid datetime.\n"
63             . "Fallback to file timestamp.\n";
64 2         13 return undef;
65             } else {
66 0         0 die;
67             }
68 4         71 };
69              
70 4         1250 return $date;
71             }
72              
73             sub match {
74 10     10 1 24 my ( $self, $f ) = @_;
75              
76 10         91 return $f =~ /\.jpe?g$/i; ## no critic
77             # TODO: should we use something more complicated here? maybe mime type?
78             }
79              
80             1;
81              
82             __END__