File Coverage

blib/lib/Image/IPTCInfo/TemplateFile.pm

Criterion	Covered	Total	%
statement	59	75	78.6
branch	17	32	53.1
condition	10	24	41.6
subroutine	6	7	85.7
pod	0	4	0.0
total	92	142	64.7

package Image::IPTCInfo::TemplateFile;
use strict;
use Carp;

=head1 NAME

Image::IPTCInfo::TemplateFile - Template files for IPTC IIM Text

=cut

use vars '$VERSION';
$VERSION = "0.2";

=head1 VERSION

This is version 0.2 - keywords and supplemental categories were
not saved in the previous version.

=cut

require Image::IPTCInfo;
# our @ISA = 'Image::IPTCInfo';

=head1 DEPENDENCIES

	Image::IPTCInfo

=head1 DESCRIPTION

Based on C by Josh Carter ([e-mail]),
this allows the loading of data from an IPTC template file, such as
used by FotoStation(TM).

=head1 CONSTRUCTOR

Pass an array, hash reference, array reference, or list.

The IPTC text content can be obtained from a (clsoed) file,
an file handle, or can be passe directly to the constructor.

=over 4

=item TO INSTANTIATE DIRECTLY

To load IPTC data "manually", supply to the constructor any or all of
the datafields whose names are defined as in the parent module
(L).  Note that both the 'list' items
"supplemental category" (I) and "keywords" can be supplied
as either a comma-delimited list or array references.

Exmaple:

	Image::IPTCInfo::TemplateFile->new (
		'caption/abstract' => 'The caption",
		'keywords'         => 'keyword1,keyword2, keywordN',
	)

=item TO INSTANTIATE FROM A TEMPLATE FILE

Supply a C paramter, the path to a template file to open.
This file should be just the first IPTC code: record 2, dataset 0,
such as generated by this module or FotoStation(TM).

=item TO INSTANTIATE FROM A FILE HANDLE

Supply the paramter C as an open filehandle,
from which we'll load, and then close.
The file should already be at the start of the first
IPTC code: record 2, dataset 0.

=back

When called, the constructor parses the template, filling
a hash with the fields defined in C, a
reference to which becomes this object.

If no info is found, the object will be empty.

=cut

sub new { my $class = shift;
	my $self;
	if (ref $_[0] eq 'HASH'){
		$self = shift;
	} elsif (ref $_[0] eq 'ARRAY') {
		$self = { @{$_[0]} };
	} elsif (not ref $_[0] and $#_>0) {
		$self = {@_};
	} else {
		croak "You must supply a FILE or filepath argument in a hash, list or array";
	}
	bless $self,$class || __PACKAGE__;
	if ($self->{filepath}){
		open $self->{FILE},$self->{filepath};
		binmode $self->{FILE};
	}
	if ($self->{FILE}){
		$self->collect;
		close $self->{FILE};
		delete $self->{FILE};
		delete $self->{filepath};
	}
	return $self;
}


sub collect { my $self = shift;
	while (1) {
		my $header;
		read($self->{FILE}, $header, 5);
		my ($tag, $record, $dataset, $length) = unpack("CCCn", $header);

		# bail if we're past end of IIM record 2 data
		return unless (defined $tag and $tag == 0x1c) && (defined $record and $record == 2);

		my $value;
		read($self->{FILE}, $value, $length);

		#warn "tag     : " . $tag . "\n";
		#warn "record  : " . $record . "\n";
		#warn "dataset : " . $dataset . " - ",
		#	($Image::IPTCInfo::listdatasets{$dataset}||$Image::IPTCInfo::datasets{$dataset}),"\n";
		#warn "length  : " . $length  . "\n";
		#warn "value   : $value\n\n";

		# try to extract first into _listdata (keywords, categories)
		# and, if unsuccessful, into _data. Discard unknown tags
		if (exists $Image::IPTCInfo::listdatasets{$dataset}){
			push @{$self->{$Image::IPTCInfo::listdatasets{$dataset}}}, $value;
		}
		elsif (exists $Image::IPTCInfo::datasets{$dataset}) {
			$self->{$Image::IPTCInfo::datasets{$dataset}} = $value;
		}
		# else discard
	}
}


=head1 METHOD add_to_Image_IPTC_Info

Transfers the data from the calling object to
an C object supplied in the
only paramter.

Returns true or C if no object was supplied.

=cut

sub add_to_Image_IPTC_Info { my ($self,$object) = (shift,shift);
	return undef unless defined $object and ref $object;
	foreach my $i (keys %Image::IPTCInfo::listdatasets){
		$object->{_listdata}->{$i} = $self->{$i};
	}
	foreach my $i (keys %Image::IPTCInfo::datasets){
		$object->{_data} = $self->{$i};
	}
	return 1;
}


sub as_blob { my $self = shift;
	my $out;

	# First, we need to build a mapping of datanames to dataset
	# numbers if we haven't already.
	unless (scalar(keys %Image::IPTCInfo::datanames)){
		foreach my $dataset (keys %Image::IPTCInfo::datasets){
			my $dataname = $Image::IPTCInfo::datasets{$dataset};
			$Image::IPTCInfo::datanames{$dataname} = $dataset;
		}
	}
	# Ditto for the lists
	unless (scalar(keys %Image::IPTCInfo::listdatanames)){
		foreach my $dataset (keys %Image::IPTCInfo::listdatasets) {
			my $dataname = $Image::IPTCInfo::listdatasets{$dataset};
			$Image::IPTCInfo::listdatanames{$dataname} = $dataset;
		}
	}

	# Print record version
	# tag - record - dataset - len (short) - 2 (short)
	$out .= pack("CCCnn", 0x1c, 2, 0, 2, 2);

	# Iterate over data sets
	foreach my $key (keys %$self){
		my $dataset = $Image::IPTCInfo::datanames{$key};
		if (not $dataset or $dataset == 0) {
			warn "PackedIIMData: illegal dataname $key" if $^W;
			next;
		}
		$out .= pack("CCCn", 0x1c, 0x02, $dataset, (length($self->{$key} || 0 ) ));
		$out .= $self->{$key} || "";
	}

	# Do the same for list data sets
	# foreach my $key (keys %{$self->{_listdata}}){
	foreach my $key ( keys %Image::IPTCInfo::listdatanames ){
		my $dataset = $Image::IPTCInfo::listdatanames{$key};
		if ($dataset == 0){
			warn "PackedIIMData: illegal dataname $key" if $^W;
			next;
		}

		#foreach my $value (@{$self->{_listdata}->{$key}}){
		if ( not ref $self->{$key} ){
			$self->{$key} = [split/\s*,\s*/, $self->{$key}];
		}

		foreach my $value (@{$self->{$key}}){
			$out .= pack("CCCn", 0x1c, 0x02, $dataset, length($value))
				. $value;
		}
	}
	return $out;
}

1;
__END__