Image-MetaData-JPEG

 view release on metacpan or  search on metacpan

lib/Image/MetaData/JPEG/dumpers/app1_exif.pl  view on Meta::CPAN

    # after the Interop. arrays there can be a link to the next IFD
    # (this takes 4 bytes). $next = 0 --> write the next IFD offset,
    # = 1 --> write zero, 2 --> do not write these four bytes.
    $ifd_content .= pack $long, $remote if $next == 0;
    $ifd_content .= pack $long, 0       if $next == 1;
    # then, we save the remote data area
    $ifd_content .= $extra;
    # if the thumbnail offset tags were found during the scan, we
    # need to overwrite their values with a meaningful offset now.
    for (keys %th_tags) {
	next unless my $overwrite = $th_tags{$_};
	my $tag_record = $this->search_record($_, $dirref);
	$tag_record->set_value($remote);
	my $new_offset = $tag_record->get($this->{endianness});
	substr($ifd_content, $overwrite, length $new_offset) = $new_offset; }
    # return a reference to the scalar which holds the binary dump
    # of this IFD (to be saved in the caller routine, I think).
    return \$ifd_content;
}

###########################################################
# This routine dumps all kinds of makernotes. Have a look #
# at parse_makernote() for further details.               #
###########################################################
sub dump_makernote {
    my ($this, $dirnames, $offset) = @_;
    # look for a MakerNote subdirectory beginning with $dirnames: the
    # actual name has the format appended, e.g., MakerNoteData_Canon.
    $dirnames =~ s/(.*@|)([^@]*)/$1/;
    my $dirref = $this->search_record_value($dirnames);
    $dirnames .= $_->{key}, $dirref = $_->get_value(), last
	for (grep{$_->{key}=~/^$2/} @$dirref);
    # Also look for the subdir with special information.
    my $spcref = $this->search_record_value($dirnames.'@special');
    # entering here without the dir and its subdir being present is an error
    $this->die('MakerNote subdirs not found') unless $dirref && $spcref;
    # read all MakerNote special values (added by the parser routine)
    my ($data, $signature, $endianness, $format, $error) =
	map { $this->search_record_value($_, $spcref) }
            ('ORIGINAL', 'SIGNATURE', 'ENDIANNESS', 'FORMAT', 'ERROR');
    # die and debug if the format record is not present
    $this->die('FORMAT not found') unless $format;
    # if the format is unknown or there was an error at parse time, it
    # is wiser to return the original, unparsed content of the MakerNote
    if ($format =~ /unknown/ || defined $error) {
	$this->die('ORIGINAL data not found') unless $data; return \$data; };
    # also extract the property table for this MakerNote format
    my $hash = $$HASH_MAKERNOTES{$format};
    # now, die if the signature or endianness is still undefined
    $this->die('Properties not found')unless defined $signature && $endianness;
    # in general, the MakerNote's next-IFD link is zero, but some
    # MakerNotes do not even have these four bytes: prepare the flag
    my $next_flag = exists $$hash{nonext} ? 2 : 1;
    # in general, MakerNote's offsets are computed from the APP1 segment
    # TIFF base; however, some formats compute offsets from the beginning
    # of the MakerNote itself: setup the offset base as required.
    $offset = length($signature) + (exists $$hash{mkntstart} ? 0 : $offset);
    # initialise the data area with the detected signature
    $data = $signature;
    # some MakerNotes have a TIFF header on their own, freeing them
    # from the relocation problem; values from this header overwrite
    # the previously assigned values; records are saved in $mknt_dir.
    if (exists $$hash{mkntTIFF}) {
	my ($TIFF_header, $TIFF_offset, $TIFF_endianness) 
	    = $this->dump_TIFF_header($spcref);
	$this->die('Endianness mismatch') if $endianness ne $TIFF_endianness;
	$data .= $TIFF_header; $offset = $TIFF_offset; }
    # Unstructured case: the content of the MakerNote is simply
    # a sequence of bytes, which must be encoded using $$hash{tags}
    if (exists $$hash{nonIFD}) {
	$data .= $this->search_record($$_[0], $dirref)->get($endianness)
	    for map {$$hash{tags}{$_}} sort {$a <=> $b} keys %{$$hash{tags}}; }
    # Structured case: the content of the MakerNote can be dumped
    # with dump_ifd (change locally the endianness value).
    else { local $this->{endianness} = $endianness;
	   $data .= ${$this->dump_ifd($dirnames, $offset, $next_flag)} };
    # return the MakerNote as a binary object
    return \$data;
}

# successful load
1;



( run in 1.776 second using v1.01-cache-2.11-cpan-71847e10f99 )