File Coverage

blib/lib/App/CopyrightImage.pm
Criterion Covered Total %
statement 79 85 92.9
branch 27 36 75.0
condition 7 12 58.3
subroutine 11 11 100.0
pod 1 1 100.0
total 125 145 86.2


line stmt bran cond sub pod time code
1             package App::CopyrightImage;
2              
3 3     3   13986 use 5.006;
  3         7  
4 3     3   9 use warnings;
  3         3  
  3         55  
5 3     3   9 use strict;
  3         6  
  3         52  
6              
7 3     3   7 use Exporter qw(import);
  3         4  
  3         76  
8 3     3   23 use File::Basename;
  3         3  
  3         197  
9 3     3   1244 use File::Copy;
  3         9782  
  3         146  
10 3     3   1283 use File::Find::Rule;
  3         16783  
  3         19  
11 3     3   4186 use Image::ExifTool qw(:Public);
  3         113756  
  3         2129  
12              
13             our @EXPORT = qw(imgcopyright);
14              
15             our $VERSION = '0.03';
16              
17             sub imgcopyright {
18 8     8 1 133103 my (%data) = @_;
19              
20 8 100       45 die "need to supply the 'image' argument!\n" if ! $data{src};
21 7 100 66     42 if (! $data{check} && ! $data{name}){
22 1         4 die "need to supply the 'name' argument\n";
23             }
24 6         380 $data{year} = (localtime(time))[5] + 1900;
25              
26 6 50 33     106 if ($data{dst} && -d $data{dst}){
    100          
27 0         0 $data{basename} = $data{dst};
28             }
29             elsif (-d $data{src})
30             {
31 3         10 $data{basename} = $data{src};
32             }
33             else {
34 3         145 $data{basename} = dirname $data{src};
35             }
36              
37 6 100       49 if (-d $data{src}){
38 3         2783 @{ $data{images} } = File::Find::Rule->file()
39             ->name('*.jpg', '*.jpeg')
40             ->maxdepth(1)
41 3         155 ->in($data{src});
42             }
43             else {
44 3         8 push @{ $data{images} }, $data{src};
  3         13  
45             }
46              
47 6 100       29 if ($data{check}){
48 3         9 return _check(\%data);
49             }
50             else {
51 3         11 _exif(\%data);
52             }
53             }
54             sub _exif {
55 3     3   4 my $data = shift;
56              
57 3         10 my $dst = "$data->{basename}/ci";
58              
59 3 50       58 if (! -d $dst){
60 3 50       183 mkdir $dst
61             or die "can't create the destination image directory $dst!: $!";
62             }
63              
64 3         23 my $et = Image::ExifTool->new;
65 3         249 my %errors;
66              
67 3         5 for my $img (@{ $data->{images} }){
  3         8  
68              
69             # original
70            
71 5         61 $et->ExtractInfo($img);
72              
73 5 50       105737 if ($data->{remove}){
74 0         0 $et->SetNewValue('Copyright', '');
75 0         0 $et->SetNewValue('Creator', '');
76 0         0 $et->WriteInfo($img, "$img.tmp");
77 0         0 move "$img.tmp", $img;
78 0         0 next;
79             }
80              
81 5         19 my $cp = $et->GetValue('Copyright');
82 5         199 my $cr = $et->GetValue('Creator');
83              
84 5 100 66     127 if (! $data->{force} && ($cp || $cr)){
      66        
85 1 50       3 my $set = "Copyright is already set;" if $cp;
86 1 50       4 $set .= " Creator is already set;" if $cr;
87 1         2 $errors{$img} = $set;
88 1         3 next;
89             }
90            
91 4         38 $et->SetNewValue('Copyright', "Copyright (C) $data->{year} by $data->{name}");
92 4         168783 my $creator_string = $data->{name};
93 4 50       18 $creator_string .= " ($data->{email})" if $data->{email};
94              
95 4         12 $et->SetNewValue('Creator', $creator_string);
96              
97 4         16973 my $ci_img = (fileparse($img))[0];
98 4         13 $ci_img = "$dst/ci_$ci_img";
99            
100             # write out the new image
101              
102 4         21 $et->WriteInfo($img, $ci_img);
103              
104             # updated
105              
106 4         156813 $et->ExtractInfo($ci_img);
107              
108 4 50       68226 $errors{$img} = "failed to add Copyright; "
109             if ! $et->GetValue('Copyright');
110              
111 4 50       155 $errors{$img} .= "failed to add Creator"
112             if ! $et->GetValue('Creator');
113             }
114 3         360 return %errors;
115             }
116             sub _check {
117 3     3   4 my $data = shift;
118              
119 3         22 my $et = Image::ExifTool->new;
120              
121 3         37539 for (@{ $data->{images} }){
  3         9  
122 4         13 $et->ExtractInfo($_);
123 4         100387 my $cp = $et->GetValue('Copyright');
124 4         162 my $cr = $et->GetValue('Creator');
125              
126 4         92 my $err_str;
127 4 100       18 $err_str .= " missing Copyright; " if ! $cp;
128 4 100       13 $err_str .= " missing Creator; " if ! $cr;
129              
130 4 100       27 print "$_: $err_str\n" if $err_str;
131             }
132 3         266 return ();
133             }
134              
135             1;
136             __END__