~berthold-daum/zora/trunk

« back to all changes in this revision

Viewing changes to com.bdaum.zoom.batch.unix/exiftool/lib/Image/ExifTool/Jpeg2000.pm

  • Committer: bdaum
  • Date: 2015-12-26 10:21:51 UTC
  • Revision ID: berthold.daum@bdaum.de-20151226102151-44f1j5113167thb9
VersionĀ 2.4.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
16
16
use vars qw($VERSION);
17
17
use Image::ExifTool qw(:DataAccess :Utils);
18
18
 
19
 
$VERSION = '1.23';
 
19
$VERSION = '1.25';
20
20
 
21
21
sub ProcessJpeg2000Box($$$);
22
22
 
367
367
        Name => 'CompatibleBrands',
368
368
        Format => 'undef[$size-8]',
369
369
        # ignore any entry with a null, and return others as a list
370
 
        ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a', 
 
370
        ValueConv => 'my @a=($val=~/.{4}/sg); @a=grep(!/\0/,@a); \@a',
371
371
    },
372
372
);
373
373
 
514
514
        # (native JPEG2000 information is always preferred, so don't check IsCreating)
515
515
        next unless $$tagInfo{List} or $et->IsOverwriting($nvHash) > 0;
516
516
        next if $$nvHash{EditOnly};
517
 
        my @vals = $et->GetNewValues($nvHash);
 
517
        my @vals = $et->GetNewValue($nvHash);
518
518
        my $val;
519
519
        foreach $val (@vals) {
520
520
            my $boxhdr = pack('N', length($val) + 8) . $$tagInfo{TagID};
583
583
    my ($pos, $boxLen);
584
584
    for ($pos=$dirStart; ; $pos+=$boxLen) {
585
585
        my ($boxID, $buff, $valuePtr);
 
586
        my $hdrLen = 8;     # the box header length
586
587
        if ($raf) {
587
588
            $dataPos = $raf->Tell() - $base;
588
 
            my $n = $raf->Read($buff,8);
589
 
            unless ($n == 8) {
 
589
            my $n = $raf->Read($buff,$hdrLen);
 
590
            unless ($n == $hdrLen) {
590
591
                $n and $err = '', last;
591
592
                if ($outfile) {
592
593
                    CreateNewBoxes($et, $outfile) or $err = 1;
594
595
                last;
595
596
            }
596
597
            $dataPt = \$buff;
597
 
            $dirLen = 8;
 
598
            $dirLen = $dirEnd = $hdrLen;
598
599
            $pos = 0;
599
 
        } elsif ($pos >= $dirEnd - 8) {
 
600
        } elsif ($pos >= $dirEnd - $hdrLen) {
600
601
            $err = '' unless $pos == $dirEnd;
601
602
            last;
602
603
        }
603
 
        $boxLen = unpack("x$pos N",$$dataPt);
 
604
        $boxLen = unpack("x$pos N",$$dataPt);   # (length includes header and data)
604
605
        $boxID = substr($$dataPt, $pos+4, 4);
605
 
        $pos += 8;
 
606
        $pos += $hdrLen;                # move to end of box header
606
607
        if ($boxLen == 1) {
607
 
            if (not $raf and $pos < $dirLen - 8) {
608
 
                $err = 'JPEG 2000 format error';
609
 
            } else {
610
 
                $err = "Can't currently handle huge JPEG 2000 boxes";
 
608
            # box header contains an additional 8-byte integer for length
 
609
            $hdrLen += 8;
 
610
            if ($raf) {
 
611
                my $buf2;
 
612
                if ($raf->Read($buf2,8) == 8) {
 
613
                    $buff .= $buf2;
 
614
                    $dirLen = $dirEnd = $hdrLen;
 
615
                }
611
616
            }
612
 
            last;
 
617
            $pos > $dirEnd - 8 and $err = '', last;
 
618
            my ($hi, $lo) = unpack("x$pos N2",$$dataPt);
 
619
            $hi and $err = "Can't currently handle JPEG 2000 boxes > 4 GB", last;
 
620
            $pos += 8;                  # move to end of extended-length box header
 
621
            $boxLen = $lo - $hdrLen;    # length of remaining box data
613
622
        } elsif ($boxLen == 0) {
614
623
            if ($raf) {
615
624
                if ($outfile) {
625
634
                }
626
635
                last;   # (ignore the rest of the file when reading)
627
636
            }
628
 
            $boxLen = $dirLen - $pos;
 
637
            $boxLen = $dirEnd - $pos;   # data runs to end of file
629
638
        } else {
630
 
            $boxLen -= 8;
 
639
            $boxLen -= $hdrLen;         # length of remaining box data
631
640
        }
632
641
        $boxLen < 0 and $err = 'Invalid JPEG 2000 box length', last;
633
642
        my $tagInfo = $et->GetTagInfo($tagTablePtr, $boxID);
642
651
                    $raf->Seek($boxLen, 1) or $err = 'Seek error', last;
643
652
                }
644
653
            } elsif ($outfile) {
645
 
                Write($outfile, substr($$dataPt, $pos-8, $boxLen+8)) or $err = '', last;
 
654
                Write($outfile, substr($$dataPt, $pos-$hdrLen, $boxLen+$hdrLen)) or $err = '', last;
646
655
            }
647
656
            next;
648
657
        }
652
661
            $raf->Read($buff,$boxLen) == $boxLen or $err = '', last;
653
662
            $valuePtr = 0;
654
663
            $dataLen = $boxLen;
655
 
        } elsif ($boxLen + $pos > $dirStart + $dirLen) {
 
664
        } elsif ($pos + $boxLen > $dirEnd) {
656
665
            $err = '';
657
666
            last;
658
667
        } else {