File Coverage

blib/lib/MP3/Tag/ImageExifTool.pm
Criterion Covered Total %
statement 27 53 50.9
branch 8 34 23.5
condition 2 21 9.5
subroutine 7 13 53.8
pod 0 5 0.0
total 44 126 34.9


line stmt bran cond sub pod time code
1             package MP3::Tag::ImageExifTool;
2              
3 6     6   39 use strict;
  6         11  
  6         169  
4 6     6   29 use File::Basename;
  6         11  
  6         347  
5             #use File::Spec;
6 6     6   35 use vars qw /$VERSION @ISA/;
  6         12  
  6         2484  
7              
8             $VERSION="1.14";
9             @ISA = 'MP3::Tag::__hasparent';
10              
11             =pod
12              
13             =head1 NAME
14              
15             MP3::Tag::ImageExifTool - extract size info from image files via L.
16              
17             =head1 SYNOPSIS
18              
19             my $db = MP3::Tag::ImageExifTool->new($filename); # Name of multimedia file
20              
21             see L
22              
23             =head1 DESCRIPTION
24              
25             MP3::Tag::ImageExifTool is designed to be called from the MP3::Tag module.
26              
27             It implements the (standard) methods qw(title track artist album year genre comment),
28             as well as width(), height(), bit_depth(), _duration() and mime_type() methods (sizes in pixels).
29              
30             Use method C to access a particular field provided by C.
31              
32             These methods return C if C is not available, or does not return valid data.
33              
34             =cut
35              
36              
37             # Constructor
38              
39             sub new_with_parent {
40 85     85 0 289 my ($class, $f, $p, $e, %seen, @cue) = (shift, shift, shift);
41 85 50       306 $f = $f->filename if ref $f;
42 85         306 bless [$f], $class;
43             }
44              
45             sub new {
46 0     0 0 0 my ($class, $f) = (shift, shift);
47 0         0 $class->new_with_parent($f, undef, @_);
48             }
49              
50             # Destructor
51              
52       0     sub DESTROY {}
53              
54             sub __info ($) {
55 187     187   392 my $self = shift;
56 187 100       418 unless (defined $self->[1]) {
57 26         70 my $v = eval { require Image::ExifTool;
  26         9752  
58 26         321521 Image::ExifTool->new()->ImageInfo($self->[0], '-id3:*') };
59             # How to detect errors?
60 26 100       1099770 $self->[1] = $v->{Error} ? '' : $v;
61             }
62 187         1638 return $self->[1];
63             }
64              
65             my %tr = qw( mime_type MIMEType year Date width ImageWidth height ImageHeight
66             bit_depth BitDepth );
67              
68             for my $elt ( qw( title track artist album year genre comment mime_type
69             width height ) ) {
70             my $n = ($tr{$elt} or ucfirst $elt);
71             my $is_genre = ($elt eq 'genre');
72             my $r = sub ($) {
73 187     187   434 my $info = shift()->__info;
74 187 100       520 return unless $info;
75 156         306 my $v = $info->{$n};
76 156 50 66     446 $v =~ s/^None$// if $is_genre and $v;
77 156         462 return $v;
78             };
79 6     6   47 no strict 'refs';
  6         12  
  6         3239  
80             *$elt = $r;
81             }
82              
83             sub bit_depth ($) {
84 0     0 0   my $info = shift()->__info;
85 0 0         return unless $info;
86             $info->{BitsPerSample} || $info->{Depth} || $info->{BitDepth}
87 0 0 0       }
88              
89             sub field ($$) {
90 0     0 0   my $info = shift()->__info;
91 0 0         return unless $info;
92 0           $info->{shift()}
93             }
94              
95             sub _duration ($) {
96 0     0     my $info = shift()->__info;
97 0 0         return unless $info;
98 0           my($d, $dd) = $info->{Duration};
99 0 0 0       if (defined $d and $d =~ /\d/) {
100 0           $dd = 1;
101 0 0         return $d if $d =~ /^\d*(\.\d*)?$/;
102             }
103             # Probably this is already covered by Duration? No, it is usually rounded...
104 0           my($c, $r, $r1) = map $info->{$_}, qw(FrameCount VideoFrameRate FrameRate);
105 0 0 0       unless (defined $c and $r ||= $r1) { # $d usually contains rounded value
      0        
106 0 0 0       return $1*3600 + $2*60 + $3 if $dd and $d =~ /^(\d+):(\d+):(\d+(\.\d*)?)$/;
107 0 0 0       return $1*60 + $2 if $dd and $d =~ /^(\d+):(\d+(\.\d*)?)$/;
108 0           return;
109             }
110 0 0         $r = 30/1.001 if $r =~ /^29.97\d*^/;
111 0 0         $r = 24/1.001 if $r =~ /^23.9(7\d*|8)$/;
112 0           $c/$r
113             }
114              
115             sub img_type ($) {
116 0     0 0   my $self = shift;
117 0           my $t = $self->mime_type;
118 0 0         return uc $1 if $t =~ m(^image/(.*));
119 0           return;
120             }
121              
122             1;