File Coverage

blib/lib/App/CopyrightImage.pm
Criterion Covered Total %
statement 84 85 98.8
branch 30 38 78.9
condition 10 15 66.6
subroutine 11 11 100.0
pod 1 1 100.0
total 136 150 90.6


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