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

package SWISH::Filters::IPTC2html;
use strict;
use warnings;
use vars qw( $VERSION @ISA );
$VERSION = '0.190';
@ISA     = ('SWISH::Filters::Base');

sub new {

    my ($class) = @_;
    my $self = bless {
        mimetypes => [qr!image/jpeg!],    # list of types this filter handles
    }, $class;
    return $self->use_modules(qw/ Image::IPTCInfo /);
}

sub filter {

    my ( $self, $doc ) = @_;
    my $file = $doc->fetch_filename;

    my $user_meta = $doc->meta_data || {};

    # Create new info object
    my $info = Image::IPTCInfo->new($file);

    # Check if file had IPTC data
    return unless defined($info);

    # Get specific attributes...
    my $caption = $info->Attribute('caption/abstract');

    # does it need escaping? silly test
    if ( $caption =~ m/[<>&]/ ) {
        $caption = $self->escapeXML($caption);
    }

    my $headers = "$caption\n"
        . $self->format_meta_headers($user_meta);

    # update the document's content type
    # uncommented set_content_type() to fix RT bug #20887
    $doc->set_content_type('text/html');

    my $xml = $info->ExportXML('image');

    my $txt = <


$headers


$xml


EOF

    return (
        \$txt,
        {   title => $caption,
            map { $_ => $user_meta->{$_} } keys %$user_meta
        }
    );
}

1;

__END__