File Coverage

blib/lib/SWISH/Filters/IPTC2html.pm
Criterion Covered Total %
statement 12 26 46.1
branch 0 4 0.0
condition 0 2 0.0
subroutine 4 5 80.0
pod 1 2 50.0
total 17 39 43.5


line stmt bran cond sub pod time code
1             package SWISH::Filters::IPTC2html;
2 1     1   1404 use strict;
  1         1  
  1         33  
3 1     1   4 use warnings;
  1         1  
  1         26  
4 1     1   3 use vars qw( $VERSION @ISA );
  1         1  
  1         308  
5             $VERSION = '0.191';
6             @ISA = ('SWISH::Filters::Base');
7              
8             sub new {
9              
10 1     1 0 23 my ($class) = @_;
11 1         9 my $self = bless {
12             mimetypes => [qr!image/jpeg!], # list of types this filter handles
13             }, $class;
14 1         6 return $self->use_modules(qw/ Image::IPTCInfo /);
15             }
16              
17             sub filter {
18              
19 0     0 1   my ( $self, $doc ) = @_;
20 0           my $file = $doc->fetch_filename;
21              
22 0   0       my $user_meta = $doc->meta_data || {};
23              
24             # Create new info object
25 0           my $info = Image::IPTCInfo->new($file);
26              
27             # Check if file had IPTC data
28 0 0         return unless defined($info);
29              
30             # Get specific attributes...
31 0           my $caption = $info->Attribute('caption/abstract');
32              
33             # does it need escaping? silly test
34 0 0         if ( $caption =~ m/[<>&]/ ) {
35 0           $caption = $self->escapeXML($caption);
36             }
37              
38 0           my $headers = "$caption\n"
39             . $self->format_meta_headers($user_meta);
40              
41             # update the document's content type
42             # uncommented set_content_type() to fix RT bug #20887
43 0           $doc->set_content_type('text/html');
44              
45 0           my $xml = $info->ExportXML('image');
46              
47 0           my $txt = <
48            
49            
50             $headers
51            
52            
53             $xml
54            
55            
56             EOF
57              
58             return (
59 0           \$txt,
60             { title => $caption,
61 0           map { $_ => $user_meta->{$_} } keys %$user_meta
62             }
63             );
64             }
65              
66             1;
67              
68             __END__