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

	Image::IPTCInfo

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

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

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

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
	}
}

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__