File Coverage

blib/lib/SWISH/Filters/ImageToMD5Xml.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package SWISH::Filters::ImageToMD5Xml;
2 1     1   20057 use strict;
  1         2  
  1         44  
3 1     1   5 use warnings;
  1         1  
  1         33  
4 1     1   4 use base 'SWISH::Filters::Base';
  1         4  
  1         631  
5 1     1   4034 use Digest::MD5 qw(md5);
  1         2  
  1         61  
6 1     1   273 use XML::Simple;
  0            
  0            
7              
8             =head1 NAME
9              
10             SWISH::Filters::ImageToMD5Xml - Adds MD5 information when filtering an image for SWISHE.
11              
12             =head1 VERSION
13              
14             Version 0.02
15              
16             =cut
17              
18             our $VERSION = '0.03';
19              
20              
21             =head1 SYNOPSIS
22              
23             A SWISHE filter that takes an incoming image XML applies a MD5 checksum
24             against the binary content of the image.
25              
26             =head1 METHODS
27              
28             =head2 new ( $class )
29              
30             Constructor.
31              
32             =cut
33              
34             sub new {
35             my ( $class ) = @_;
36              
37             $class = ref $class || $class;
38              
39             my $self = bless { }, $class;
40              
41             return $self->_init;
42             }
43              
44             sub _init {
45             my ( $self ) = @_;
46              
47             $self->use_modules(qw/MIME::Base64 Search::Tools::XML XML::Simple/);
48              
49             my @mimetypes = (
50             'application/xml'
51             );
52              
53             $self->{mimetypes} = \@mimetypes;
54              
55             return $self;
56             }
57              
58             sub _parse_xml {
59             my ( $self, $xml ) = @_;
60              
61             if ( $xml ) {
62             return XMLin($xml);
63             }
64             }
65              
66             =head2 filter( $self, $doc )
67              
68             Generates XML meta data for indexing.
69              
70             =cut
71              
72             sub filter {
73             my ( $self, $doc ) = @_;
74              
75             return if $doc->is_binary;
76              
77             if ( my $xml = $doc->fetch_filename ) {
78             if ( my $ds = $self->_parse_xml($xml) ) {
79             my $utils = Search::Tools::XML->new;
80             $ds->{md5} = md5($ds->{b64_data});
81             my $xml = $utils->perl_to_xml($ds, 'image_data', );
82             $doc->set_content_type('application/xml');
83             return $xml;
84             }
85             }
86              
87             return;
88             }
89              
90              
91             =head1 AUTHOR
92              
93             Logan Bell, C<< >>
94              
95             =head1 BUGS
96              
97             Please report any bugs or feature requests to C, or through
98             the web interface at L. I will be notified, and then you'll
99             automatically be notified of progress on your bug as I make changes.
100              
101              
102              
103              
104             =head1 SUPPORT
105              
106             You can find documentation for this module with the perldoc command.
107              
108             perldoc SWISH::Filters::ImageToMD5Xml
109              
110              
111             You can also look for information at:
112              
113             =over 4
114              
115             =item * RT: CPAN's request tracker (report bugs here)
116              
117             L
118              
119             =item * AnnoCPAN: Annotated CPAN documentation
120              
121             L
122              
123             =item * CPAN Ratings
124              
125             L
126              
127             =item * Search CPAN
128              
129             L
130              
131             =back
132              
133              
134             =head1 ACKNOWLEDGEMENTS
135              
136              
137             =head1 LICENSE AND COPYRIGHT
138              
139             Copyright 2011 Logan Bell.
140              
141             This program is free software; you can redistribute it and/or modify it
142             under the terms of either: the GNU General Public License as published
143             by the Free Software Foundation; or the Artistic License.
144              
145             See http://dev.perl.org/licenses/ for more information.
146              
147              
148             =cut
149              
150             1; # End of SWISH::Filters::ImageToMD5Xml