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<Image::IPTCInfo> by Josh Carter (josh@multipart-mixed.com),
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<Image::IPTCInfo>).  Note that both the 'list' items
"supplemental category" (I<sic>) 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<filepath> 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<FILE> 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<Image::IPTCInfo>, 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<Image::IPTCInfo> object supplied in the
only paramter.

Returns true or C<undef> 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__

=head1 AUTHOR AND COPYRIGHT

Copyright (C) 2002 Josh Carter (josh@multipart-mixed.com)
Copyright (C) 2003 Lee Goddard (lgoddard@cpan.org)

=head1 SEE ALSO

L<Image::IPTCInfo>.