File Coverage

lib/Image/Animated/JPEG.pm

Criterion	Covered	Total	%
statement	179	200	89.5
branch	134	200	67.0
condition	28	96	29.1
subroutine	9	11	81.8
pod	4	8	50.0
total	354	515	68.7

package Image::Animated::JPEG;

use strict;
use warnings;

use Encode;

our $VERSION = '0.01_2';

sub index {
	my $io_file = shift;
	my $args = shift;

	my @frames;

	print "Parsing file...\n" if $args && $args->{debug};

	# check
	my $soi = my_read($io_file, 2);
	unless ($soi eq "\xFF\xD8") {
		die "Does not look like a JPEG file: SOI missing at start of file";
	}

	# first frame
	my $cnt = 1;
	print " frame $cnt begins at 0\n" if $args && $args->{debug};
	push(@frames, {
		offset	=> 0,
		io_file	=> $io_file, # hand over, per frame (might be multiple files)
	});

	# subsequent frames
	local $/ = "\xFF\xD9\xFF\xD8"; # we look for EOI+SOI marker to avoid false-positives with embedded thumbs
	while(my $chunk = <$io_file>){
		my $pos = tell($io_file) - 2; # -2: compensate for inclusion of begin-marker
		print " frame $cnt ends at $pos\n" if $args && $args->{debug};
		push(@frames, {
			offset	=> $pos,
			io_file	=> $io_file, # a quirk for playajpeg: hand over the fh, per frame, as playajpeg may play a sequence of jpegs as animation
		});
		$frames[$cnt - 1]->{length} = $pos - $frames[$cnt - 1]->{offset};
		$cnt++;
	}
	seek($io_file, 0,0); # rewind fh
	pop(@frames); # last boundary is not beginning of a new frame
	$frames[-1]->{length} += 2; # last frame won't end with EOI+SOI

	return \@frames;
}

sub process {	# mostly from Image::Info
	my $args = $_[1];

	my $fh;
	if(ref($_[0]) eq 'SCALAR'){
		require IO::String;
		$fh = IO::String->new($_[0]) or die "Error using scalar-ref for reading: $!";
	}else{
		open($fh, "<", $_[0]) or die "Error opening file for reading: $!";
		binmode($fh);
	}

	my $soi = my_read($fh, 2, ($args && $args->{debug} ? 1 : undef));
	unless ($soi eq "\xFF\xD8") {
		my $offset = tell($fh) - 2;
		die "Does not look like a JPEG file: SOI missing at offset $offset";
	}

	my %markers;
	my @warnings;
	while (1) {
		my($ff, $mark) = unpack("CC", my_read($fh, 2, ($args && $args->{debug} ? 1 : undef)));
		last if !defined $ff;

		if ($ff != 0xFF) {	# enter when processing a chunk
		    my $corrupt_bytes = 2;
		    while(1) {
			my($ff) = unpack("C", my_read($fh,1, ($args && $args->{debug} ? 1 : undef)));
			return if !defined $ff;
			last if $ff == 0xFF;
			$corrupt_bytes++;
		    }
		    $mark = unpack("C", my_read($fh,1, ($args && $args->{debug} ? 1 : undef)));
		    push(@warnings, sprintf("Corrupt JPEG data, $corrupt_bytes extraneous bytes before marker 0x%02x", $mark));
		}
		if ($mark == 0xFF) {	# munge FFs (JPEG markers can be padded with unlimited 0xFF's)
		    for (;;) {
			($mark) = unpack("C", my_read($fh, 1, ($args && $args->{debug} ? 1 : undef)));
			last if $mark != 0xFF;
		    }
		}

		last if $mark == 0xDA || $mark == 0xD9;  # exit once we reach a SOS marker, or EOI (end of image)

		print "marker: FF ".sprintf("%#x",$mark)." \n" if $args && $args->{debug};
		my $marker_pos = tell($fh) - 2;
		my($len) = unpack("n", my_read($fh, 2, ($args && $args->{debug} ? 1 : undef))); # we found a marker, read its size
		last if $len < 2; # data-less marker

		last if $mark < 0xE0; # data-less marker

		# process_chunk($info, $img_no, $mark, my_read($fh, $len - 2));
		if($mark == 0xE0){
			my $data = my_read($fh, $len - 2, ($args && $args->{debug} ? 1 : undef));
			print "APP0 at ". $marker_pos ." len:$len \n" if $args && $args->{debug};

			# get_name($fh);
			my $name;
			my $rel_offset = 0;
			for(0..10){ # app-identifiers may be arbitrarily long, but let's stop after 10 bytes
				my ($value) = unpack("C", read_bytes(\$data, \$rel_offset, 1));
				last if $value == 0x00;
				$name .= chr($value);
			}

			$markers{$name} = {
				type => 'APP0',
				offset => $marker_pos,
				length => $len,
				data_offset => ($marker_pos + 4) + (length($name) + 1),
				data_length => ($len - 2) - (length($name) + 1)
			};
		}else{
			seek($fh,$len - 2,1);
		}

	}

#	print Dumper(\%markers,\@warnings);
	return \%markers;
}

sub my_read {	# from Image::Info
	my($fh, $len) = @_;
	print " my_read: len:$len \n" if $_[2];
	my $buf;
	my $n = read($fh, $buf, $len);
	die "read failed: $!" unless defined $n;
	die "short read ($len/$n) at pos " . tell($fh) unless $n == $len;
	$buf;
}


sub encode_ajpeg_marker {
	return "AJPEG\000" . encode_ajpeg_data(@_);
}

sub decode_ajpeg_marker {
	return decode_ajpeg_data( substr($_[0],6) );
}

#   +------------- segment --------------+
#   | APP0-marker	  		 |
#   |		  +--"marker" / data ----+
#   | 		  | AJPEG-marker	 |
#   | 		  | 			 |
#   \x00
#    FF E0   00 00   AJPEG       00  ...

## expects a hashref
## encodes hash keys according to the AJPEG schema
sub encode_ajpeg_data {
	my $ref = shift;
	my $args = shift; # debug, future: version

	die "encode_ajpeg_data expects a hash-ref" unless $ref && ref($ref) eq 'HASH';

	my $binary;

	$binary = pack("C1",0); # version:0

	for my $key (keys %$ref){
		unless(defined($ref->{$key})){
			warn "encode_ajpeg_data: $key value is undef and will be ignored!" if $args && $args->{debug};
			next;
		}
		if($key eq 'version'){
			warn "encode_ajpeg_data: Only format version 0 is currenty implemented!" if $args && $args->{debug} && $ref->{$key} != 0;
			next;
		}
		if($key eq 'delay'){
			if($ref->{$key} <= 255){
				print "encode_ajpeg_data: delay $ref->{$key} (byte)\n" if $args && $args->{debug};
				$binary .= "\x01" . pack("C",$ref->{$key});
			}elsif($ref->{$key} <= 65535){
				print "encode_ajpeg_data: delay $ref->{$key} (short)\n" if $args && $args->{debug};
				$binary .= "\x02" . pack("n",$ref->{$key});
			}else{
				print "encode_ajpeg_data: delay $ref->{$key} (long)\n" if $args && $args->{debug};
				$binary .= "\x04" . pack("N",$ref->{$key});
			}
		}elsif($key eq 'repeat'){
			if($ref->{$key} <= 255){
				print "encode_ajpeg_data: repeat $ref->{$key} (byte)\n" if $args && $args->{debug};
				$binary .= "\x11" . pack("C",$ref->{$key});
			}elsif($ref->{$key} <= 65535){
				print "encode_ajpeg_data: repeat $ref->{$key} (short)\n" if $args && $args->{debug};
				$binary .= "\x12" . pack("n",$ref->{$key});
			}else{
				die "repeat values must be <= 65535";
			}
		}elsif($key eq 'parse_next'){
			if($ref->{$key} <= 255){
				$binary .= "\x21" . pack("C",$ref->{$key});
			}elsif($ref->{$key} <= 65535){
				$binary .= "\x22" . pack("n",$ref->{$key});
			}else{
				die "parse_next values must be <= 65535";
			}
		}elsif($key eq 'length'){
			if($ref->{$key} <= 255){
				$binary .= "\x31" . pack("C",$ref->{$key});
			}elsif($ref->{$key} <= 65535){
				$binary .= "\x32" . pack("n",$ref->{$key});
			}else{
				$binary .= "\x34" . pack("N",$ref->{$key});
			}
		}elsif($key eq 'previous'){
			if($ref->{$key} <= 255){
				$binary .= "\x41" . pack("C",$ref->{$key});
			}elsif($ref->{$key} <= 65535){
				$binary .= "\x42" . pack("n",$ref->{$key});
			}else{
				$binary .= "\x44" . pack("N",$ref->{$key});
			}
		}elsif($key eq 'x_offset'){
			if($ref->{$key} <= 255){
				$binary .= "\x51" . pack("C",$ref->{$key});
			}elsif($ref->{$key} <= 65535){
				$binary .= "\x52" . pack("n",$ref->{$key});
			}else{
				die "x_offset values must be <= 65535";
			}
		}elsif($key eq 'y_offset'){
			if($ref->{$key} <= 255){
				$binary .= "\x61" . pack("C",$ref->{$key});
			}elsif($ref->{$key} <= 65535){
				$binary .= "\x62" . pack("n",$ref->{$key});
			}else{
				die "x_offset values must be <= 65535";
			}
		}elsif($key eq 'dispose_op'){
			if($ref->{$key} <= 2){
				$binary .= "\x71" . pack("C",$ref->{$key});
			}else{
				die "dispose_op values must be <= 2";
			}
		}elsif($key eq 'metadata'){
			# skip, for later
		}else{
			warn "encode_ajpeg_data: '$key' is not recognized";
		}
	}

	# specs do not require it, but it may make sense to sort
	# "potentially longer" byte segments, like metadata, to the end
	# of the AJPEG segmemt
	if($ref->{'metadata'}){ # A0
		print "encode_ajpeg_data: metadata \n" if $args && $args->{debug};
		for my $mkey (keys %{ $ref->{'metadata'} }){
			print " metadata: ". $mkey .":". $ref->{'metadata'}->{$mkey} ."\n" if $args && $args->{debug};
			my $mkey_utf8 = encode('utf-8',$mkey);
			my $mvalue_utf8 = encode('utf-8',$ref->{'metadata'}->{$mkey});

			$binary .= pack("C",160) . pack("C",length($mkey_utf8)) . $mkey_utf8 . pack("C",length($mvalue_utf8)) . $mvalue_utf8;
		}
	}

	return $binary;
}


sub read_bytes {
	my $binary_ref = shift;
	my $offset_ref = shift; # quirk: offset as ref, so a read_bytes(), like core::read, advances a pointer/offset
	my $length = shift;

	# print "  read $length bytes at ${$offset_ref} \n";
	my $data = substr(${$binary_ref}, ${$offset_ref}, $length);
	${$offset_ref} += $length;

	return $data;
}

## expects a scalar holding binary data
# decodes AJPEG schema binary encoded keys and values
sub decode_ajpeg_data {
	my $binary = shift;
	my $args = shift; # debug

	die "decode_ajpeg_data expects a scalar with binary data" unless defined($binary);

	my $length = length($binary);
	my $offset = 0;

	my %ref;

	print "decode_ajpeg_data: length:$length \n" if $args && $args->{debug};
	$ref{version} = unpack("C", read_bytes(\$binary,\$offset,1));
	print "decode_ajpeg_data: version:$ref{version} \n" if $args && $args->{debug};

	my $cnt;
	for(;;){
		$cnt++;

		my $byte = read_bytes(\$binary,\$offset, 1);
		if($byte){ # an "empty AJPEG marker" will only hold version, read_bytes beyond that will return undef (thus we skip $key_num/properties decoding)
			my $key_num = unpack("C", $byte);
			if($key_num == 1){
				$ref{'delay'} = unpack("C", read_bytes(\$binary,\$offset,1));
				print "decode_ajpeg_data: delay: $ref{'delay'} (byte) \n" if $args && $args->{debug};
			}elsif($key_num == 2){
				$ref{'delay'} = unpack("n", read_bytes(\$binary,\$offset,2));
				print "decode_ajpeg_data: delay: $ref{'delay'} (short) \n" if $args && $args->{debug};
			}elsif($key_num == 4){
				$ref{'delay'} = unpack("N1", read_bytes(\$binary,\$offset,4));
				print "decode_ajpeg_data: delay: $ref{'delay'} (long) \n" if $args && $args->{debug};
			}elsif($key_num == 17){
				$ref{'repeat'} = unpack("C", read_bytes(\$binary,\$offset,1));
				print "decode_ajpeg_data: repeat: $ref{'repeat'} (byte) \n" if $args && $args->{debug};
			}elsif($key_num == 18){
				$ref{'repeat'} = unpack("n", read_bytes(\$binary,\$offset,2));
				print "decode_ajpeg_data: repeat: $ref{'repeat'} (short) \n" if $args && $args->{debug};
			}elsif($key_num == 33){
				$ref{'parse_next'} = unpack("C", read_bytes(\$binary,\$offset,1));
			}elsif($key_num == 34){
				$ref{'parse_next'} = unpack("n", read_bytes(\$binary,\$offset,2));
			}elsif($key_num == 49){
				$ref{'length'} = unpack("C", read_bytes(\$binary,\$offset,1));
			}elsif($key_num == 50){
				$ref{'length'} = unpack("n", read_bytes(\$binary,\$offset,2));
			}elsif($key_num == 52){
				$ref{'length'} = unpack("N", read_bytes(\$binary,\$offset,4));
			}elsif($key_num == 65){
				$ref{'previous'} = unpack("C", read_bytes(\$binary,\$offset,1));
			}elsif($key_num == 66){
				$ref{'previous'} = unpack("n", read_bytes(\$binary,\$offset,2));
			}elsif($key_num == 68){
				$ref{'previous'} = unpack("N", read_bytes(\$binary,\$offset,4));
			}elsif($key_num == 81){
				$ref{'x_offset'} = unpack("C", read_bytes(\$binary,\$offset,1));
			}elsif($key_num == 82){
				$ref{'x_offset'} = unpack("n", read_bytes(\$binary,\$offset,2));
			}elsif($key_num == 97){
				$ref{'y_offset'} = unpack("C", read_bytes(\$binary,\$offset,1));
			}elsif($key_num == 98){
				$ref{'y_offset'} = unpack("n", read_bytes(\$binary,\$offset,2));
			}elsif($key_num == 113){
				$ref{'dispose_op'} = unpack("C", read_bytes(\$binary,\$offset,1));
			}elsif($key_num == 160){ # 0xA0
				my $mkey_utf8 = read_bytes(\$binary,\$offset, unpack('C',read_bytes(\$binary,\$offset,1)) );
				my $mvalue_utf8 = read_bytes(\$binary,\$offset, unpack('C',read_bytes(\$binary,\$offset,1)) );

				my $mkey = decode('utf-8', $mkey_utf8) if defined($mkey_utf8);
				my $mvalue = decode('utf-8', $mvalue_utf8) if defined($mvalue_utf8);
				print "decode_ajpeg_data: metadata: ". $mkey .":". $mvalue ." \n" if $args && $args->{debug};
				$ref{'metadata'}->{$mkey} = $mvalue;
			}
		}
		last if $offset >= $length;
	}

	return \%ref;
}

1;

__END__