tiff.pm

稀饭伊人相册系统继承了新天堂多用户相册系统的功能

              },
    0xA301 => {__TAG__ => "SceneType",
               DECODER => \&scene_type_decoder,
              },
);

my %tiff_tags = (
  255   => { __TAG__ => "SubfileType",
	     1 => "FullResolution",
	     2 => "ReducedResolution",
	     3 => "SinglePage",
	   },
  256   => "width",
  257   => "height",
  258   => "BitsPerSample",
  259   => { __TAG__ => "Compression",
	     1 => "PackBytes",
	     2 => "CCITT Group3",
	     3 => "CCITT T4",
	     4 => "CCITT T6",
	     5 => "LZW",
	     6 => "JPEG",
	     32773 => "PackBits",
           },
  262   => { __TAG__ => "PhotometricInterpretation",
	     0 => "WhiteIsZero",
	     1 => "BlackIsZero",
             2 => "RGB",
	     3 => "RGB Palette",
	     4 => "Transparency Mask",
	     5 => "CMYK",
	     6 => "YCbCr",
	     8 => "CIELab",
	   },
  263   => { __TAG__ => "Threshholding",
	     1 => "NoDithering",
	     2 => "OrderedDither",
	     3 => "Randomized",
	   },
  270   => "ImageDescription",
  271   => "Make",
  272   => "Model",
  273   => "StipOffset",
  274   => { __TAG__ => "Orientation",
	     1 => "top_left",
	     2 => "top_right",
	     3 => "bot_right",
	     4 => "bot_left",
	     5 => "left_top",
	     6 => "right_top",
	     7 => "right_bot",
	     8 => "left_bot",
	   },
  277   => "SamplesPerPixel",
  278   => "RowsPerStrip",
  279   => "StripByteCounts",
  282   => "XResolution",
  283   => "YResolution",
  284   => {__TAG__ => "PlanarConfiguration",
	    1 => "Chunky", 2 => "Planar",
	},
  296   => {__TAG__ => "ResolutionUnit",
	    1 => "pixels", 2 => "dpi", 3 => "dpcm",
	   },
  305   => "Software",
  306   => "DateTime",
  513   => "JPEGInterchangeFormat",
  514   => "JPEGInterchangeFormatLngth",
  531   => "YCbCrPositioning",
  33432 => "Copyright",
  34665 => { __TAG__ => "ExifOffset",
	     __SUBIFD__ => \%exif_tags,
	   },
);


sub new
{
    my $class = shift;
    my $source = shift;

    if (!ref($source)) {
	local(*F);
	open(F, $source) || return;
	binmode(F);
	$source = \*F;
    }

    if (ref($source) ne "SCALAR") {
	# XXX should really only read the file on demand
	local($/);  # slurp mode
	my $data = <$source>;
	$source = \$data;
    }

    my $self = bless { source => $source }, $class;

    for ($$source) {
	my $byte_order = substr($_, 0, 2);
	$self->{little_endian} = ($byte_order eq "II");
	$self->{version} = $self->unpack("n", substr($_, 2, 2));

	my $ifd = $self->unpack("N", substr($_, 4, 4));
	while ($ifd) {
	    push(@{$self->{ifd}}, $ifd);
	    my($num_fields) = $self->unpack("x$ifd n", $_);
	    $ifd = $self->unpack("N", substr($_, $ifd + 2 + $num_fields*12, 4));
	}
    }

    $self;
}

sub unpack
{
    my $self = shift;
    my $template = shift;
    if ($self->{little_endian}) {
	$template =~ tr/nN/vV/;
    }
    CORE::unpack($template, $_[0]);
}

sub num_ifds
{
    my $self = shift;
    scalar @{$self->{ifd}};
}

sub ifd
{
    my $self = shift;
    my $num = shift || 0;
    my @ifd;
    return $self->add_fields($self->{ifd}[$num], \@ifd);
}

sub tagname
{
    $tiff_tags{$_[1]} || sprintf "Tag-0x%04x",$_[1];
}

sub add_fields
{
    my($self, $offset, $ifds, $tags, $voff_plus) = @_;
    return unless $offset;
    $tags ||= \%tiff_tags;

    for (${$self->{source}}) {  # alias as $_
	my $entries = $self->unpack("x$offset n", $_);
      FIELD:
	for my $i (0 .. $entries-1) {
	    my($tag, $type, $count, $voff) =
		$self->unpack("nnNN", substr($_, 2 + $offset + $i*12, 12));
	    $voff += $voff_plus || 0;
	    my $val;
	    if (my $t = $types[$type]) {
		$type = $t->[0];
		my $tmpl = $t->[1];
		my $vlen = $t->[2];
		if ($count * $vlen <= 4) {
		    $voff = 2 + $offset + $i*12 + 8;
		}
		$tmpl =~ s/(\d+)$/$count*$1/e;

		my @v = $self->unpack("x$voff$tmpl", $_);

		if ($type =~ /^S(SHORT|LONG|RATIONAL)/) {
		    my $max = 2 ** ($1 eq "SHORT" ? 15 : 31);
		    $v[0] -= ($max * 2) if $v[0] >= $max;
		}

		$val = (@v > 1) ? \@v : $v[0];
		bless $val, "Image::TIFF::Rational" if $type =~ /^S?RATIONAL$/;
	    }
	    $tag = $tags->{$tag} || $self->tagname($tag);

	    if ($tag eq 'MakerNote' && exists $makernotes{$self->{Make}.' '.$self->{Model}}) {
                my ($ifd_off, $tag_prefix, $sub) = @{$makernotes{$self->{Make}.' '.$self->{Model}}};
                $self->{tag_prefix} = $tag_prefix;
	        if ($ifd_off < 0) {
                    # fuji kludge -  http://www.butaman.ne.jp/~tsuruzoh/Computer/Digicams/exif-e.html#APP4
                    my $save_endian = $self->{little_endian};
                    $self->{little_endian} = 1;
                    $ifd_off = $self->unpack("N", substr($val, 8, 4));
		    $self->add_fields($voff+$ifd_off, $ifds, $sub, $voff);
                    $self->{little_endian} = $save_endian;
                } else {
	            $self->add_fields($voff+$ifd_off, $ifds, $sub);
                }
                delete $self->{tag_prefix};
	        next FIELD;
            }

	    if (ref($tag)) {
		die "Assert" unless ref($tag) eq "HASH";
		if (my $sub = $tag->{__SUBIFD__}) {
		    $self->add_fields($val, $ifds, $sub);
		    next FIELD;
		}
		#hack for UNDEFINED values, they all have different
		#meanings depending on tag
		$val = $tag->{DECODER}($self,$val) if defined($tag->{DECODER});
		$val = $tag->{$val} if exists $tag->{$val};
		$tag = $tag->{__TAG__};
	    }

            $tag = $self->{tag_prefix} . '-' . $tag if $self->{tag_prefix};
	    $self->_push_field($ifds, $tag, $type, $count, $val);
            $self->{$tag} = $val if ($tag eq 'Make' or $tag eq 'Model');
	}
    }
    $ifds;
}

sub _push_field
{
    my $self = shift;
    my $ifds = shift;
    push(@$ifds, [@_]);
}

sub components_configuration_decoder
{
    my $self = shift;
    my $val = shift;
    my $rv = "";
    my %v = ( 
                0 => undef,
                1 => 'Y',
                2 => 'Cb',
                3 => 'Cr',
                4 => 'R',
                5 => 'G',
                6 => 'B',
            );
return join ( '', map { $v{$_} if defined($v{$_}) } $self->unpack('c4',$val) );
}

sub file_source_decoder
{
    my $self = shift;
    my $val = shift;
    my %v = ( 
                3 => "(DSC) Digital Still Camera",
            );
    $val = $self->unpack('c',$val); 
    return $v{$val} if $v{$val};
return "Other";
}

sub scene_type_decoder
{
    my $self = shift;
    my $val = shift;
    my %v = ( 
                1 => "Directly Photographed Image",
            );
    $val = $self->unpack('c',$val); 
    return $v{$val} if $v{$val};
return "Other";
}

package Image::TIFF::Rational;

use overload '""' => \&as_string,
             '0+' => \&as_float,
             fallback => 1;

sub new {
    my($class, $a, $b) = @_;
    bless [$a, $b], $class;
}

sub as_string {
    my $self = shift;
    #warn "@$self";
    "$self->[0]/$self->[1]";
}

sub as_float {
    my $self = shift;
    $self->[0] / $self->[1];
}

1;