File Coverage

blib/lib/Metabrik/Image/Exif.pm
Criterion Covered Total %
statement 9 62 14.5
branch 0 36 0.0
condition 0 27 0.0
subroutine 3 10 30.0
pod 1 6 16.6
total 13 141 9.2


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # image::exif Brik
5             #
6             package Metabrik::Image::Exif;
7 1     1   1027 use strict;
  1         3  
  1         30  
8 1     1   6 use warnings;
  1         2  
  1         29  
9              
10 1     1   6 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         15  
  1         953  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes_default => {
19             capture_mode => 1,
20             },
21             commands => {
22             install => [ ], # Inherited
23             get_metadata => [ qw(file) ],
24             get_gps_coordinates => [ qw(file) ],
25             get_field => [ qw(file field) ],
26             get_manufacturer => [ qw(file) ],
27             get_model => [ qw(file) ],
28             },
29             require_binaries => {
30             'exif' => [ ],
31             },
32             need_packages => {
33             ubuntu => [ qw(exif) ],
34             debian => [ qw(exif) ],
35             kali => [ qw(exif) ],
36             },
37             };
38             }
39              
40             sub get_metadata {
41 0     0 0   my $self = shift;
42 0           my ($file) = @_;
43              
44 0 0         $self->brik_help_run_undef_arg('get_metadata', $file) or return;
45 0 0         $self->brik_help_run_file_not_found('get_metadata', $file) or return;
46              
47 0           my $cmd = "exif $file";
48 0 0         my $lines = $self->execute($cmd) or return;
49              
50 0           my %fields = ();
51 0           for my $line (@$lines) {
52 0           my @toks = split(/\s*\|\s*/, $line);
53 0 0 0       if (defined($toks[0]) && defined($toks[1])) {
54 0           $fields{$toks[0]} = $toks[1];
55             }
56             }
57              
58 0           return \%fields;
59             }
60              
61             sub get_gps_coordinates {
62 0     0 0   my $self = shift;
63 0           my ($file) = @_;
64              
65 0 0         $self->brik_help_run_undef_arg('get_gps_coordinates', $file) or return;
66 0 0         $self->brik_help_run_file_not_found('get_gps_coordinates', $file) or return;
67              
68 0 0         my $fields = $self->get_metadata($file) or return;
69              
70 0           my $north_south = $fields->{"North or South Latit"};
71 0           my $east_west = $fields->{"East or West Longitu"};
72 0           my $latitude = $fields->{"Latitude"};
73 0           my $longitude = $fields->{"Longitude"};
74              
75 0 0 0       if (defined($north_south) && defined($east_west)
      0        
      0        
76             && defined($latitude) && defined($longitude)) {
77             # Google Maps format: 47°36'16.146"N,7°24'52.48"E
78 0           my @l = split(/\s*,\s*/, $latitude);
79 0           my @L = split(/\s*,\s*/, $longitude);
80              
81 0 0 0       if (defined($l[0]) && defined($l[1]) && defined($l[2])
      0        
      0        
      0        
      0        
82             && defined($L[0]) && defined($L[1]) && defined($L[2])) {
83 0           my $lati = "$l[0]°$l[1]'$l[2]\"$north_south";
84 0           my $long = "$L[0]°$L[1]'$L[2]\"$east_west";
85              
86 0           return [ $lati, $long ];
87             }
88             }
89              
90 0           return 'undef';
91             }
92              
93             # No check for Args version (internal version)
94             sub _get_field {
95 0     0     my $self = shift;
96 0           my ($file, $field) = @_;
97              
98 0 0         my $fields = $self->get_metadata($file) or return;
99              
100 0           my $info = $fields->{$field};
101 0 0         if (defined($info)) {
102 0           return $info;
103             }
104              
105 0           return 'undef';
106             }
107              
108             # Check for Args vesion (user version)
109             sub get_field {
110 0     0 0   my $self = shift;
111 0           my ($file, $field) = @_;
112              
113 0 0         $self->brik_help_run_undef_arg('get_field', $file) or return;
114 0 0         $self->brik_help_run_undef_arg('get_field', $field) or return;
115 0 0         $self->brik_help_run_file_not_found('get_field', $file) or return;
116              
117 0           return $self->_get_field($file, $field);
118             }
119              
120             sub get_manufacturer {
121 0     0 0   my $self = shift;
122 0           my ($file) = @_;
123              
124 0 0         $self->brik_help_run_undef_arg('get_manufacturer', $file) or return;
125 0 0         $self->brik_help_run_file_not_found('get_manufacturer', $file) or return;
126              
127 0           return $self->_get_field($file, 'Manufacturer');
128             }
129              
130             sub get_model {
131 0     0 0   my $self = shift;
132 0           my ($file) = @_;
133              
134 0 0         $self->brik_help_run_undef_arg('get_model', $file) or return;
135 0 0         $self->brik_help_run_file_not_found('get_model', $file) or return;
136              
137 0           return $self->_get_field($file, 'Model');
138             }
139              
140             1;
141              
142             __END__