Re^2: Multipage TIFFs

I played around with Image::ExifTool and had a realization. When I printed all of the tags from a TIFF using Image::ExifTool, it didn't return any tags which explicitly contained the number of pages in the TIFF. It did, however, return tags from each of the pages past page 1 in a "$tag ($page-1)" format.

I wrote this ugly piece of code which does the job perfectly:

use Image::ExifTool;

sub pageCount {
    my $FILE = shift;
    my $EXIFTOOL = new Image::ExifTool;
    my $INFO = $EXIFTOOL -> ImageInfo( $FILE );
    my $TAG;
    my $DONE = 0;
    my $PAGECOUNT = "1";

    while ( $DONE == 0 ) {
        $TAG = "ImageWidth ($PAGECOUNT)";
        my $VAL = $EXIFTOOL -> GetValue( $TAG );
        if ( !$VAL ) {
            $DONE = 1;
        }
        else {
            $PAGECOUNT++;
        }
    }
    return( $PAGECOUNT );
}
[download]

In essence, I keep looking for pages until GetValue returns undefined. It's far from a great solution, but it works.

Thanks for pointing me in the right direction!

Comment on Re^2: Multipage TIFFs Download Code

Replies are listed 'Best First'.
Re^3: Multipage TIFFs by hangon (Deacon) on Nov 02, 2007 at 06:00 UTC
I see you solved the problem, but since I already wrote this I'll post it for anyone who can use it. The program traverses the tiff file's image directory chain. Testing on an old 900MHz windoz box, it ripped through 1200 tiff files, over 2 GB, in 23 seconds. use strict; my @files = glob "D:/pics/tiff/.tif"; for (@files){ my $images = imagecounter($_); printf "%40s : %3d \n", $_, $images; } sub imagecounter{ my $tiff = shift; my @endian; my $offset = 0; my $index; my $count = 0; open (my $fh, "<", $tiff); binmode $fh; seek ($fh, $offset, 0); read ($fh, $endian[0], 2); $endian[0] = unpack "a2", $endian[0]; if ($endian[0] eq 'II'){ $endian[1] = 'v'; $endian[2] = 'V'; }elsif ($endian[0] eq 'MM'){ $endian[1] = 'n'; $endian[2] = 'N'; }else{ warn "Unknown byte order in $tiff, possible bad file\n"; return 0; } seek ($fh, 4, 0); read ($fh, $offset, 4); $offset = unpack "$endian[2]", $offset; while ($offset){ $count++; my $length; seek ($fh, $offset, 0); read ($fh, $length, 2); $length = unpack "$endian[1]", $length; $index = ($length 12); seek ($fh, $index, 1); read ($fh, $offset, 4); $offset = unpack "$endian[2]", $offset; if ($count > 100){ warn "Count too high in $tiff, possible bad file\n"; return 0; } } close $fh; return $count; } [download]	[reply] [d/l]

Replies are listed 'Best First'.

Re^3: Multipage TIFFs
by hangon (Deacon) on Nov 02, 2007 at 06:00 UTC

I see you solved the problem, but since I already wrote this I'll post it for anyone who can use it. The program traverses the tiff file's image directory chain. Testing on an old 900MHz windoz box, it ripped through 1200 tiff files, over 2 GB, in 23 seconds.

use strict;

my @files = glob "D:/pics/tiff/*.tif";
for (@files){
    my $images = imagecounter($_);
    printf "%40s : %3d \n", $_, $images;
}


sub imagecounter{
    my $tiff = shift;
    my @endian;
    my $offset = 0;
    my $index;
    my $count = 0;

    open (my $fh, "<", $tiff);
    binmode $fh;
    seek ($fh, $offset, 0);
    read ($fh, $endian[0], 2);

    $endian[0] = unpack "a2", $endian[0];
    if ($endian[0] eq 'II'){
        $endian[1] = 'v';
        $endian[2] = 'V';
    }elsif ($endian[0] eq 'MM'){
        $endian[1] = 'n';
        $endian[2] = 'N';
    }else{
        warn "Unknown byte order in $tiff, possible bad file\n";
        return 0;
    }

    seek ($fh, 4, 0);
    read ($fh, $offset, 4);
    $offset = unpack "$endian[2]", $offset;

    while ($offset){
        $count++;
        my $length;
        seek ($fh, $offset, 0);
        read ($fh, $length, 2);
        $length = unpack "$endian[1]", $length;
        $index = ($length * 12);
        seek ($fh, $index, 1);
        read ($fh, $offset, 4);
        $offset = unpack "$endian[2]", $offset;
        if ($count > 100){
            warn "Count too high in $tiff, possible bad file\n";
            return 0;
        } 
    }
    close $fh;
    return $count;
}
[download]

[reply]
[d/l]