libimage-metadata-jpeg-perl 0.153-1 / usr / share / perl5 / Image / MetaData / JPEG / access / comments.pl

###########################################################
# A Perl package for showing/modifying JPEG (meta)data.   #
# Copyright (C) 2004,2005,2006 Stefano Bettelli           #
# See the COPYING and LICENSE files for license terms.    #
###########################################################
package Image::MetaData::JPEG;
use Image::MetaData::JPEG::Segment;
no  integer;
use strict;
use warnings;

###########################################################
# This method accepts a string and returns a list whose   #
# elements are not larger than the length limit imposed   #
# by a JPEG segment: a segment cannot have a length which #
# couldn't be written in a 2-byte unsigned integer, that  #
# is 2^16 - 1; since the byte count must be written in    #
# this space, the real comment is limited to 2^16 - 3.    #
# The length of all but the last element in the list is   #
# maximal. The input string is not changed. Note that ""  #
# maps to (""), while an undefined value maps to (). So,  #
# it is possible to specify an empty comment.             #
###########################################################
{ my $max_length = 2**16 - 3;
  sub split_comment_string {
      return () unless defined $_[0];
      map { substr $_[0], $max_length*$_, $max_length }
      0 .. (-1 + length $_[0]) / $max_length;
  }
}

###########################################################
# This method returns the number of comment segments in   #
# the picture (it should be as fast as possible).         #
###########################################################
sub get_number_of_comments {
    my ($this) = @_;
    # return the length of the output of this method
    return scalar $this->get_segments('COM');
}

###########################################################
# This method returns a list, with an element for each    #
# comment block in the file (the element contains the     #
# comment string). Note that an empty list can be retur-  #
# ned (in case there are no comment blocks).              #
###########################################################
sub get_comments {
    my ($this) = @_;
    # loop over all segments, and return the appropriate
    # field of those which are comments.
    my @com_segs = $this->get_segments('COM');
    return map { $_->search_record_value('Comment') } @com_segs;
}

###########################################################
# This method adds one or more new comment segments to    #
# the JPEG file, based on the string passed by the user.  #
# If there is already at least one comment segment, the   #
# new segments are created right after the last one.      #
# Otherwise, the standard position search is applied.     #
# ------------------------------------------------------- #
# In case the passed string is too big (there is a 64KB   #
# limit in JPEG segments), it is broken down in smaller   #
# strings and multiple "Comment" segments are inserted in #
# the file (they are contiguous).                         #
###########################################################
sub add_comment {
    my ($this, $string) = @_;
    # create one or more comment blocks, based on the user
    # string; the string must be split if it is too long.
    my @new_comments = 
	map { new Image::MetaData::JPEG::Segment("COM", \ $_) }
        split_comment_string($string);
    # get the list of comment indexes
    my @indexes = $this->get_segments('COM', 'INDEXES');
    # our position is right after the last comment
    my $position = @indexes ? 1 + $indexes[$#indexes] : undef;
    # actually insert the comments (we don't need update() here);
    # if position is undefined, the standard search is used
    $this->insert_segments(\ @new_comments, $position);
}

###########################################################
# This method replaces the $index-th comment segment with #
# one or more new segments based on $string (the index of #
# the first comment segment is 0). If $string is too big  #
# (see add_comment), it is broken down and multiple seg-  #
# ments are created. If $string is undef, the comment     #
# segment is erased. If $index is out-of-bound, only a    #
# warning is printed.                                     #
###########################################################
sub set_comment {
    my ($this, $index, $string) = @_;
    # return immediately if $index is negative or undefined
    return $this->warn('Undefined $index') unless defined $index;
    return $this->warn("Negative index ($index)") if $index < 0;
    # get the list of comment segment indexes
    my @indexes = $this->get_segments('COM', 'INDEXES');
    # if $index is out of bound, warn and return. 
    return $this->warn("Index $index out of bound [0,$#indexes]")
	if ($#indexes < $index);
    # otherwise, set an index to the target comment segment
    my $position = $indexes[$index];
    # create one or more comment blocks, based on the user
    # string; the string must be split if it is too long.
    my @new_comments = 
	map { new Image::MetaData::JPEG::Segment('COM', \ $_) }
        split_comment_string($string);
    # replace the target segment with the new segments created
    # from the user string; @new_comments is the void list if
    # $string is undefined (this stands for comment deletion).
    # Since all comments are deleted or added, but not modified,
    # there is no need to call update here!
    $this->insert_segments(\ @new_comments, $position, 1);
}

###########################################################
# This method eliminates the $index-th comment segment    #
# (first index is 0). It is only a shortcut for the more  #
# general set_comment (called with $string = undef).      #
###########################################################
sub remove_comment {
    my ($this, $index) = @_;
    # call set_comment with an undefined string
    $this->set_comment($index, undef);
}

###########################################################
# This method (a wrapper around the drop_segments method) #
# eliminates all comments currently present in the pic.   #
###########################################################
sub remove_all_comments {
    my ($this) = @_;
    # use this more general method
    $this->drop_segments('^COM$');
}

###########################################################
# This method joins some comments into a single one, with #
# the supplied separation string. This utility is neces-  #
# sary because there are readers out there which do not   #
# read past the first comment. This method overwrites the #
# first comment selected by the arguments and delete the  #
# others. A warning is issued for each illegal comment    #
# index (undefined, not a number, out of range).          #
# The final comment length is checked (<64Kb).            #
# ------------------------------------------------------- #
# If no separation string is provided, it defaults to \n. #
# If no index is provided in @selection, it is assumed    #
# that the method must join all the comments into the     #
# first one, and delete the others.                       #
###########################################################
sub join_comments {
    my ($this, $separation, @selection) = @_;
    # get all the comment indexes
    my @indexes = $this->get_segments('COM', 'INDEXES');
    # get all the comment strings
    my @comments = $this->get_comments();
    # an undefined separation string defaults to "\n"
    $separation = "\n" unless defined $separation;
    # an undefined @selection stands for "all the indexes"
    @selection = 0..$#indexes unless @selection;
    # discard the elements of @selection which do not make
    # sense, and leave the others in ascending numerical order
    @selection = sort {$a <=> $b} map {
	my $error = undef;
	if    (! defined $_)         { $error = "Undefined comment index"; }
	elsif ($_ =~ /[^\d]/)        { $error = "'$_' not a whole number"; }
	elsif ($_<0 || $_>$#indexes) { $error = "index $_ out of range"; }
	$this->die("$error: discarding index") if defined $error;
	defined $error ? () : $_;
    } @selection;
    # return immediately if @selection is empty
    $this->die('No valid comment indexes') unless @selection;
    # concatenate valid comments in a single string (write a copy
    # of the separation string between every two comments).
    my $joint_comment = join $separation, map { $comments[$_] } @selection;
    # extract the first comment segment index in the selection list
    # as the target segment index. Then remove all other comments;
    # be careful to remove comments starting from higher indexes!
    my $target_index = shift @selection;
    $this->remove_comment($_) for (sort {$b <=> $a} @selection);
    # replace the target comment with $joint_comment
    $this->set_comment($target_index, $joint_comment);
}

# successful package load
1;