← Back to branch summary

~berthold-daum/zora/trunk

« back to all changes in this revision

Viewing changes to com.bdaum.zoom.batch.unix/exiftool/lib/Image/ExifTool/Ricoh.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:
com.bdaum.zoom.batch.unix/exiftool/lib/Image/ExifTool/Ricoh.pm
19
19
use Image::ExifTool qw(:DataAccess :Utils);
20
20
use Image::ExifTool::Exif;
21
21
 
22
 
$VERSION = '1.30';
 
22
$VERSION = '1.31';
23
23
 
24
24
sub ProcessRicohText($$$);
25
25
sub ProcessRicohRMETA($$$);
87
87
            2 => 'JPEG',
88
88
            3 => 'DNG',
89
89
        },
90
 
    },            
 
90
    },
91
91
    0x1001 => [{
92
92
        Name => 'ImageInfo',
93
93
        Condition => '$format ne "int16u"',
116
116
            1 => 'Continuous',
117
117
            8 => 'AF-priority Continuous',
118
118
        },
119
 
    },            
 
119
    },
120
120
    0x1003 => [{
121
121
        Name => 'Sharpness',
122
122
        Condition => '$format ne "int16u"',
603
603
    # the significance of the following 2 dates is not known.  They are usually
604
604
    # within a month of each other, but I have seen differences of nearly a year.
605
605
    # Sometimes the first is more recent, and sometimes the second.
 
606
    # 0x0003 - int32u[1]
606
607
    0x0004 => { # (NC)
607
608
        Name => 'ManufactureDate1',
608
609
        Groups => { 2 => 'Time' },
615
616
        Writable => 'string',
616
617
        Count => 20,
617
618
    },
 
619
    # 0x0006 - undef[16] ?
 
620
    # 0x0007 - int32u[1] ?
618
621
    # 0x000c - int32u[2] 1st number is a counter (file number? shutter count?) - PH
619
 
    # 0x0014 - int8u[338] - could contain some data related to face detection? - PH
 
622
    # 0x0014 - int8u[338] could contain some data related to face detection? - PH
620
623
    # 0x0015 - int8u[2]: related to noise reduction?
621
624
    0x001a => { #PH
622
625
        Name => 'FaceInfo',
644
647
    # 0x000E ProductionNumber? (ref 2) [no. zero for most models - PH]
645
648
);
646
649
 
647
 
 
648
650
# Ricoh Theta subdirectory tags - Contains orientation information (ref 4)
649
651
%Image::ExifTool::Ricoh::ThetaSubdir = (
650
652
    GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
651
653
    WRITE_PROC => \&Image::ExifTool::Exif::WriteExif,
652
654
    CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
653
 
    # 0x0001 => Unknown
654
 
    # 0x0002 => Unknown
 
655
    # 0x0001 - int16u[1] ?
 
656
    # 0x0002 - int16u[1] ?
655
657
    0x0003 => {
656
658
        Name => 'Accelerometer',
657
659
        Writable => 'rational64s',
661
663
        Name => 'Compass',
662
664
        Writable => 'rational64u',
663
665
    },
664
 
    # 0x0005 => Unknown
665
 
    # 0x0101 => Unknown - ISO Speed?
666
 
    # 0x0102 => Unknown - F Number?
667
 
    # 0x0103 => Unknown - Exposure?
668
 
    # 0x0104 => Unknown - Serial Number?
669
 
    # 0x0105 => Unknown - Serial Number?
 
666
    # 0x0005 - int16u[1] ?
 
667
    # 0x0006 - int16u[1] ?
 
668
    # 0x0007 - int16u[1] ?
 
669
    # 0x0008 - int16u[1] ?
 
670
    # 0x0009 - int16u[1] ?
 
671
    0x000a => {
 
672
        Name => 'TimeZone',
 
673
        Writable => 'string',
 
674
    },
 
675
    # 0x0101 - int16u[4] ISO (why 4 values?)
 
676
    # 0x0102 - rational64s[2] FNumber (why 2 values?)
 
677
    # 0x0103 - rational64u[2] ExposureTime (why 2 values?)
 
678
    # 0x0104 - string[9] SerialNumber?
 
679
    # 0x0105 - string[9] SerialNumber?
670
680
);
671
681
 
672
682
# face detection information (ref PH, CX4)
976
986
    my $verbose = $et->Options('Verbose');
977
987
 
978
988
    $et->VerboseDir('Ricoh RMETA') if $verbose;
979
 
    $dirLen > 6 or $et->Warn('Truncated Ricoh RMETA data', 1), return 0;
 
989
    $dirLen < 20 and $et->Warn('Truncated Ricoh RMETA data', 1), return 0;
980
990
    my $byteOrder = substr($$dataPt, $dirStart, 2);
 
991
    $byteOrder = GetByteOrder() if $byteOrder eq "\0\0"; # (same order as container)
981
992
    SetByteOrder($byteOrder) or $et->Warn('Bad Ricoh RMETA data', 1), return 0;
 
993
    # get the RMETA segment number
982
994
    my $rmetaNum = Get16u($dataPt, $dirStart+4);
983
995
    if ($rmetaNum != 0) {
984
996
        # not sure how to recognize audio, so do it by checking for "RIFF" header
999
1011
        }
1000
1012
        return 1;
1001
1013
    }
1002
 
    # standard RMETA tag directory
1003
 
    my (@tags, @vals, @nums, $valPos);
1004
 
    my $pos = $dirStart + 6;
 
1014
    # decode standard RMETA tag directory
 
1015
    my (@tags, @vals, @nums, $valPos, $numPos);
 
1016
    my $pos = $dirStart + Get16u($dataPt, $dirStart+8);
 
1017
    my $numEntries = Get16u($dataPt, $pos);
 
1018
    $numEntries > 100 and $et->Warn('Bad RMETA entry count'), return 0;
 
1019
    $pos += 10; # start of first RMETA section
 
1020
    # loop through RMETA sections
1005
1021
    while ($pos <= $dataLen - 4) {
1006
1022
        my $type = Get16u($dataPt, $pos);
1007
1023
        my $size = Get16u($dataPt, $pos + 2);
1012
1028
            $et->Warn('Corrupted Ricoh RMETA data', 1);
1013
1029
            last;
1014
1030
        }
1015
 
        if ($type eq 1) {
 
1031
        my $dat = substr($$dataPt, $pos, $size);
 
1032
        if ($verbose) {
 
1033
            $et->VPrint(2, "$$et{INDENT}RMETA section type=$type size=$size\n");
 
1034
            if ($verbose > 2) {
 
1035
                my %dumpParms = ( Addr => $$dirInfo{DataPos} + $pos, Prefix => $$et{INDENT} );
 
1036
                $dumpParms{MaxLen} = 96 if $verbose == 3;
 
1037
                Image::ExifTool::HexDump(\$dat, undef, %dumpParms);
 
1038
            }
 
1039
        }
 
1040
        if ($type == 1) {                       # section 1: tag names
1016
1041
            # save the tag names
1017
 
            my $tags = substr($$dataPt, $pos, $size);
1018
 
            $tags =~ s/\0+$//;  # remove trailing nulls
1019
 
            @tags = split /\0/, $tags;
1020
 
        } elsif ($type eq 2) {
1021
 
            # save the ASCII tag values
1022
 
            my $vals = substr($$dataPt, $pos, $size);
1023
 
            $vals =~ s/\0+$//;
1024
 
            @vals = split /\0/, $vals;
1025
 
            $valPos = $pos; # save position of first ASCII value
1026
 
        } elsif ($type eq 3) {
1027
 
            # save the numerical tag values
1028
 
            my $nums = substr($$dataPt, $pos, $size);
1029
 
            @nums = unpack($byteOrder eq 'MM' ? 'n*' : 'v*', $nums);
1030
 
        } elsif ($type eq 0) {
1031
 
            $pos += 2;  # why 2 extra bytes?
 
1042
            @tags = split /\0/, $dat, $numEntries+1;
 
1043
        } elsif ($type == 2 || $type == 18) {   # section 2/18: string values (G800 uses type 18)
 
1044
            # save the tag values (assume "ASCII\0" encoding since others never seen)
 
1045
            @vals = split /\0/, $dat, $numEntries+1;
 
1046
            $valPos = $pos; # save position of first string value
 
1047
        } elsif ($type == 3) {                  # section 3: numerical values
 
1048
            if ($size < $numEntries * 2) {
 
1049
                $et->Warn('Truncated RMETA section 3');
 
1050
            } else {
 
1051
                # save the numerical tag values
 
1052
                # (0=empty, 0xffff=text input, otherwise menu item number)
 
1053
                @nums = unpack(($byteOrder eq 'MM' ? 'n' : 'v').$numEntries, $dat);
 
1054
                $numPos = $pos; # save position of numerical values
 
1055
            }
 
1056
        } elsif ($type != 16) {
 
1057
            $et->Warn("Unrecognized RMETA section (type $type, len $size)");
1032
1058
        }
1033
1059
        $pos += $size;
1034
1060
    }
1035
 
    if (@tags or @vals) {
1036
 
        if (@tags < @vals) {
1037
 
            my ($nt, $nv) = (scalar(@tags), scalar(@vals));
1038
 
            $et->Warn("Fewer tags ($nt) than values ($nv) in Ricoh RMETA", 1);
1039
 
        }
1040
 
        # find next tag in null-delimited list
1041
 
        # unpack numerical values from block of int16u values
1042
 
        my ($tag, $name, $val);
1043
 
        foreach $tag (@tags) {
1044
 
            $val = shift @vals;
1045
 
            $val = '' unless defined $val;
1046
 
            ($name = $tag) =~ s/\b([a-z])/\U$1/gs;  # make capitalize all words
1047
 
            $name =~ s/ (\w)/\U$1/g;                # remove special characters
1048
 
            $name = 'RMETA_Unknown' unless length($name);
1049
 
            my $num = shift @nums;
1050
 
            my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
1051
 
            if ($tagInfo) {
1052
 
                # make sure print conversion is defined
1053
 
                $$tagInfo{PrintConv} = { } unless ref $$tagInfo{PrintConv} eq 'HASH';
1054
 
            } else {
1055
 
                # create tagInfo hash
1056
 
                $tagInfo = { Name => $name, PrintConv => { } };
1057
 
                AddTagToTable($tagTablePtr, $tag, $tagInfo);
1058
 
            }
1059
 
            # use string value directly if no numerical value
1060
 
            $num = $val unless defined $num;
1061
 
            # add conversion for this value (replacing any existing entry)
1062
 
            $tagInfo->{PrintConv}->{$num} = length $val ? $val : $num;
1063
 
            if ($verbose) {
1064
 
                $et->VerboseInfo($tag, $tagInfo,
1065
 
                    Table   => $tagTablePtr,
1066
 
                    Value   => $num,
1067
 
                    DataPt  => $dataPt,
1068
 
                    DataPos => $$dirInfo{DataPos},
1069
 
                    Start   => $valPos,
1070
 
                    Size    => length($val),
1071
 
                );
1072
 
            }
1073
 
            $et->FoundTag($tagInfo, $num);
1074
 
            $valPos += length($val) + 1;
1075
 
        }
 
1061
    return 1 unless @tags or @vals;
 
1062
    $valPos or $valPos = 0; # (just in case there was no value section)
 
1063
    # find next tag in null-delimited list
 
1064
    # unpack numerical values from block of int16u values
 
1065
    my ($i, $name);
 
1066
    for ($i=0; $i<$numEntries; ++$i) {
 
1067
        my $tag = $tags[$i];
 
1068
        my $val = $vals[$i];
 
1069
        $val = '' unless defined $val;
 
1070
        unless (defined $tag and length $tag) {
 
1071
            length $val or ++$valPos, next;     # (skip empty entries)
 
1072
            $tag = '';
 
1073
        }
 
1074
        ($name = $tag) =~ s/\b([a-z])/\U$1/gs;  # capitalize all words
 
1075
        $name =~ s/ (\w)/\U$1/g;                # remove special characters
 
1076
        $name = 'RMETA_Unknown' unless length($name);
 
1077
        my $num = $nums[$i];
 
1078
        my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
 
1079
        if ($tagInfo) {
 
1080
            # make sure print conversion is defined
 
1081
            $$tagInfo{PrintConv} = { } unless ref $$tagInfo{PrintConv} eq 'HASH';
 
1082
        } else {
 
1083
            # create tagInfo hash
 
1084
            $tagInfo = { Name => $name, PrintConv => { } };
 
1085
            AddTagToTable($tagTablePtr, $tag, $tagInfo);
 
1086
        }
 
1087
        # use string value directly if no numerical value
 
1088
        $num = $val unless defined $num;
 
1089
        # add conversion for this value (replacing any existing entry)
 
1090
        $tagInfo->{PrintConv}->{$num} = length $val ? $val : $num;
 
1091
        if ($verbose) {
 
1092
            my %datParms;
 
1093
            if (length $val) {
 
1094
                %datParms = ( Start => $valPos, Size => length($val), Format => 'string' );
 
1095
            } elsif ($numPos) {
 
1096
                %datParms = ( Start => $numPos + $i * 2, Size => 2, Format => 'int16u' );
 
1097
            }
 
1098
            %datParms and $datParms{DataPt} = $dataPt, $datParms{DataPos} = $$dirInfo{DataPos};
 
1099
            $et->VerboseInfo($tag, $tagInfo, Table=>$tagTablePtr, Value=>$num, %datParms);
 
1100
        }
 
1101
        $et->FoundTag($tagInfo, $num);
 
1102
        $valPos += length($val) + 1;
1076
1103
    }
1077
1104
    return 1;
1078
1105
}