← 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/Writer.pl

  • 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/Writer.pl
262
262
            if (@$value > 1) {
263
263
                # set all list-type tags first
264
264
                my $replace = $options{Replace};
 
265
                my $noJoin;
265
266
                foreach (@$value) {
 
267
                    $noJoin = 1 if ref $_;
266
268
                    my ($n, $e) = SetNewValue($self, $tag, $_, %options, ListOnly => 1);
267
269
                    $err = $e if $e;
268
270
                    $numSet += $n;
269
271
                    delete $options{Replace}; # don't replace earlier values in list
270
272
                }
 
273
                return $numSet if $noJoin;  # don't join if list contains objects
271
274
                # and now set only non-list tags
272
275
                $value = join $$self{OPTIONS}{ListSep}, @$value;
273
276
                $options{Replace} = $replace;
1080
1083
        ExtendedXMP     => $$options{ExtendedXMP},
1081
1084
        ExtractEmbedded => $$options{ExtractEmbedded},
1082
1085
        FastScan        => $$options{FastScan},
 
1086
        Filter          => $$options{Filter},
1083
1087
        FixBase         => $$options{FixBase},
1084
1088
        GlobalTimeShift => $$options{GlobalTimeShift},
1085
1089
        IgnoreMinorErrors=>$$options{IgnoreMinorErrors},
1090
1094
        ListSep         => $$options{ListSep},
1091
1095
        MakerNotes      => $$options{FastScan} && $$options{FastScan} > 1 ? undef : 1,
1092
1096
        MissingTagValue => $$options{MissingTagValue},
 
1097
        NoPDFList       => $$options{NoPDFList},
1093
1098
        Password        => $$options{Password},
1094
1099
        PrintConv       => $$options{PrintConv},
1095
1100
        QuickTimeUTC    => $$options{QuickTimeUTC},
1097
1102
        ScanForXMP      => $$options{ScanForXMP},
1098
1103
        StrictDate      => 1,
1099
1104
        Struct          => $structOpt,
 
1105
        SystemTags      => $$options{SystemTags},
1100
1106
        Unknown         => $$options{Unknown},
1101
1107
        UserParam       => $$options{UserParam},
1102
1108
        XMPAutoConv     => $$options{XMPAutoConv},
1378
1384
# 2) Must call AFTER IsOverwriting() returns 1 to get proper value for shifted times
1379
1385
# 3) Tag name is case sensitive and may be prefixed by family 0 or 1 group name
1380
1386
# 4) Value may have been modified by CHECK_PROC routine after ValueConv
1381
 
sub GetNewValues($$;$)
 
1387
sub GetNewValue($$;$)
1382
1388
{
1383
1389
    local $_;
1384
1390
    my $self = shift;
1605
1611
    my ($self, $file, $originalTime, $tag, $isUnixTime) = @_;
1606
1612
    my $nvHash;
1607
1613
    $tag = 'FileModifyDate' unless defined $tag;
1608
 
    my $val = $self->GetNewValues($tag, \$nvHash);
 
1614
    my $val = $self->GetNewValue($tag, \$nvHash);
1609
1615
    return 0 unless defined $val;
1610
1616
    my $isOverwriting = $self->IsOverwriting($nvHash);
1611
1617
    return 0 unless $isOverwriting;
1656
1662
    unless (defined $newName) {
1657
1663
        if ($opt) {
1658
1664
            if ($opt eq 'Link') {
1659
 
                $newName = $self->GetNewValues('HardLink');
 
1665
                $newName = $self->GetNewValue('HardLink');
1660
1666
            } elsif ($opt eq 'Test') {
1661
 
                $newName = $self->GetNewValues('TestName');
 
1667
                $newName = $self->GetNewValue('TestName');
1662
1668
            }
1663
1669
            return 0 unless defined $newName;
1664
1670
        } else {
1665
 
            my $filename = $self->GetNewValues('FileName', \$nvHash);
 
1671
            my $filename = $self->GetNewValue('FileName', \$nvHash);
1666
1672
            $doName = 1 if defined $filename and $self->IsOverwriting($nvHash, $file);
1667
 
            my $dir = $self->GetNewValues('Directory', \$nvHash);
 
1673
            my $dir = $self->GetNewValue('Directory', \$nvHash);
1668
1674
            $doDir = 1 if defined $dir and $self->IsOverwriting($nvHash, $file);
1669
1675
            return 0 unless $doName or $doDir;  # nothing to do
1670
1676
            if ($doName) {
1772
1778
    # first, save original file modify date if necessary
1773
1779
    # (do this now in case we are modifying file in place and shifting date)
1774
1780
    my ($nvHash, $nvHash2, $originalTime, $createTime);
1775
 
    my $fileModifyDate = $self->GetNewValues('FileModifyDate', \$nvHash);
1776
 
    my $fileCreateDate = $self->GetNewValues('FileCreateDate', \$nvHash2);
 
1781
    my $fileModifyDate = $self->GetNewValue('FileModifyDate', \$nvHash);
 
1782
    my $fileCreateDate = $self->GetNewValue('FileCreateDate', \$nvHash2);
1777
1783
    my ($aTime, $mTime, $cTime);
1778
1784
    if (defined $fileModifyDate and $self->IsOverwriting($nvHash) < 0 and
1779
1785
        defined $infile and ref $infile ne 'SCALAR')
1792
1798
#
1793
1799
    my ($numNew, $numPseudo) = $self->CountNewValues();
1794
1800
    if (not defined $outfile and defined $infile) {
1795
 
        $hardLink = $self->GetNewValues('HardLink');
1796
 
        $testName = $self->GetNewValues('TestName');
 
1801
        $hardLink = $self->GetNewValue('HardLink');
 
1802
        $testName = $self->GetNewValue('TestName');
1797
1803
        undef $hardLink if defined $hardLink and not length $hardLink;
1798
1804
        undef $testName if defined $testName and not length $testName;
1799
 
        my $newFileName =  $self->GetNewValues('FileName', \$nvHash);
1800
 
        my $newDir = $self->GetNewValues('Directory');
 
1805
        my $newFileName =  $self->GetNewValue('FileName', \$nvHash);
 
1806
        my $newDir = $self->GetNewValue('Directory');
1801
1807
        if (defined $newDir and length $newDir) {
1802
1808
            $newDir .= '/' unless $newDir =~ m{/$};
1803
1809
        } else {
1853
1859
            $raf = $inRef;
1854
1860
        } elsif ($] >= 5.006 and (eval { require Encode; Encode::is_utf8($$inRef) } or $@)) {
1855
1861
            # convert image data from UTF-8 to character stream if necessary
1856
 
            my $buff = $@ ? pack('C*',unpack('U0C*',$$inRef)) : Encode::encode('utf8',$$inRef);
 
1862
            my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$inRef)) : Encode::encode('utf8',$$inRef);
1857
1863
            if (defined $outfile) {
1858
1864
                $inRef = \$buff;
1859
1865
            } else {
2408
2414
# Functions below this are not part of the public API
2409
2415
 
2410
2416
#------------------------------------------------------------------------------
 
2417
# Maintain backward compatibility for old GetNewValues function name
 
2418
sub GetNewValues($$;$)
 
2419
{
 
2420
    my ($self, $tag, $nvHashPt) = @_;
 
2421
    return $self->GetNewValue($tag, $nvHashPt);
 
2422
}
 
2423
 
 
2424
#------------------------------------------------------------------------------
2411
2425
# Un-escape string according to options settings and clear UTF-8 flag
2412
2426
# Inputs: 0) ExifTool ref, 1) string ref or string ref ref
2413
2427
# Notes: also de-references SCALAR values
2420
2434
    # (otherwise our byte manipulations get corrupted!!)
2421
2435
    if ($] >= 5.006 and (eval { require Encode; Encode::is_utf8($$valPt) } or $@)) {
2422
2436
        # repack by hand if Encode isn't available
2423
 
        $$valPt = $@ ? pack('C*',unpack('U0C*',$$valPt)) : Encode::encode('utf8',$$valPt);
 
2437
        $$valPt = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$valPt)) : Encode::encode('utf8',$$valPt);
2424
2438
    }
2425
2439
    # un-escape value if necessary
2426
2440
    if ($$self{OPTIONS}{Escape}) {
3016
3030
            return 0;
3017
3031
        }
3018
3032
        # ensure that the shifted value is valid and reformat if necessary
3019
 
        my $checkVal = $self->GetNewValues($nvHash);
 
3033
        my $checkVal = $self->GetNewValue($nvHash);
3020
3034
        return 0 unless defined $checkVal;
3021
3035
        # don't bother overwriting if value is the same
3022
3036
        return 0 if $val eq $$nvHash{Value}[0];
3548
3562
        }
3549
3563
        last unless $self->IsOverwriting($nvHash, $dataPt ? $$dataPt : '');
3550
3564
        my $verb = 'Writing';
3551
 
        my $newVal = $self->GetNewValues($nvHash);
 
3565
        my $newVal = $self->GetNewValue($nvHash);
3552
3566
        unless (defined $newVal and length $newVal) {
3553
3567
            return '' unless $dataPt or $$dirInfo{RAF}; # nothing to do if block never existed
3554
3568
            $verb = 'Deleting';
3687
3701
        $dat =~ tr /\x00-\x1f\x7f-\xff/./;
3688
3702
        print $out "[$dat]\n";
3689
3703
    }
3690
 
    $more and printf $out "$prefix    [snip $more bytes]\n";
 
3704
    $more and print $out "$prefix    [snip $more bytes]\n";
3691
3705
}
3692
3706
 
3693
3707
#------------------------------------------------------------------------------
4146
4160
{
4147
4161
    my $self = shift;
4148
4162
    my $byteOrder = $self->Options('ByteOrder') ||
4149
 
                    $self->GetNewValues('ExifByteOrder') ||
 
4163
                    $self->GetNewValue('ExifByteOrder') ||
4150
4164
                    $$self{MAKER_NOTE_BYTE_ORDER} || 'MM';
4151
4165
    unless (SetByteOrder($byteOrder)) {
4152
4166
        warn "Invalid byte order '$byteOrder'\n" if $self->Options('Verbose');
4514
4528
    foreach $type (@types) {
4515
4529
        next unless $$self{NEW_VALUE}{$Image::ExifTool::Extra{$type}};
4516
4530
        next if $$self{"Did$type"};
4517
 
        my $val = $self->GetNewValues($type) or next;
 
4531
        my $val = $self->GetNewValue($type) or next;
4518
4532
        # DR4 record must be wrapped in VRD trailer package
4519
4533
        if ($type eq 'CanonDR4') {
4520
4534
            next if $$self{DidCanonVRD};    # (only allow one VRD trailer)
4928
4942
            last if $dirCount{Adobe};
4929
4943
            if (exists $$addDirs{Adobe} and not defined $doneDir{Adobe}) {
4930
4944
                $doneDir{Adobe} = 1;
4931
 
                my $buff = $self->GetNewValues('Adobe');
 
4945
                my $buff = $self->GetNewValue('Adobe');
4932
4946
                if ($buff) {
4933
4947
                    $verbose and print $out "Creating APP14:\n  Creating Adobe segment\n";
4934
4948
                    my $size = length($buff);
4947
4961
            if (exists $$addDirs{COM} and not defined $doneDir{COM}) {
4948
4962
                $doneDir{COM} = 1;
4949
4963
                next if $$delGroup{File} and $$delGroup{File} != 2;
4950
 
                my $newComment = $self->GetNewValues('Comment');
 
4964
                my $newComment = $self->GetNewValue('Comment');
4951
4965
                if (defined $newComment and length($newComment)) {
4952
4966
                    if ($verbose) {
4953
4967
                        print $out "Creating COM:\n";
5607
5621
                        my $val = $segData;
5608
5622
                        $val =~ s/\0+$//;   # allow for stupid software that adds NULL terminator
5609
5623
                        if ($self->IsOverwriting($nvHash, $val) or $$delGroup{File}) {
5610
 
                            $newComment = $self->GetNewValues($nvHash);
 
5624
                            $newComment = $self->GetNewValue($nvHash);
5611
5625
                        } else {
5612
5626
                            delete $$editDirs{COM}; # we aren't editing COM after all
5613
5627
                            last;
5804
5818
    }
5805
5819
    for (;;) {
5806
5820
        if ($winUni) {
5807
 
            $result = Win32API::File::MoveFileExW($old, $new,
 
5821
            $result = eval { Win32API::File::MoveFileExW($old, $new,
5808
5822
                Win32API::File::MOVEFILE_REPLACE_EXISTING() |
5809
 
                Win32API::File::MOVEFILE_COPY_ALLOWED());
 
5823
                Win32API::File::MOVEFILE_COPY_ALLOWED()) };
5810
5824
        } else {
5811
5825
            $result = rename($old, $new);
5812
5826
        }
5831
5845
    while (@_) {
5832
5846
        my $file = shift;
5833
5847
        if ($self->EncodeFileName($file)) {
5834
 
            ++$result if Win32API::File::DeleteFileW($file);
 
5848
            ++$result if eval { Win32API::File::DeleteFileW($file) };
5835
5849
        } else {
5836
5850
            ++$result if unlink $file;
5837
5851
        }
5863
5877
            $self->WarnOnce('Install Win32API::File for proper handling of Windows file times');
5864
5878
        } else {
5865
5879
            # get Win32 handle, needed for SetFileTime
5866
 
            my $win32Handle = Win32API::File::GetOsFHandle($file);
 
5880
            my $win32Handle = eval { Win32API::File::GetOsFHandle($file) };
5867
5881
            unless ($win32Handle) {
5868
5882
                $self->Warn("Win32API::File::GetOsFHandle returned invalid handle");
5869
5883
                return 0;
6019
6033
        next unless defined $val;
6020
6034
        my $nvHash = $self->GetNewValueHash($tagInfo, $$self{CUR_WRITE_GROUP});
6021
6035
        next unless $self->IsOverwriting($nvHash, $val);
6022
 
        my $newVal = $self->GetNewValues($nvHash);
 
6036
        my $newVal = $self->GetNewValue($nvHash);
6023
6037
        next unless defined $newVal;    # can't delete from a binary table
6024
6038
        # only write masked bits if specified
6025
6039
        my $mask = $$tagInfo{Mask};
6027
6041
        # set the size
6028
6042
        if ($$tagInfo{DataTag} and not $$tagInfo{IsOffset}) {
6029
6043
            warn 'Internal error' unless $newVal == 0xfeedfeed;
6030
 
            my $data = $self->GetNewValues($$tagInfo{DataTag});
 
6044
            my $data = $self->GetNewValue($$tagInfo{DataTag});
6031
6045
            $newVal = length($data) if defined $data;
6032
6046
            my $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT} || 'int32u';
6033
6047
            if ($format =~ /^int16/ and $newVal > 0xffff) {
6077
6091
            $$previewInfo{IsShort} = 1 unless $format eq 'int32u';
6078
6092
            $$previewInfo{Absolute} = 1 if $$tagInfo{IsOffset} and $$tagInfo{IsOffset} eq '3';
6079
6093
            # get the value of the Composite::PreviewImage tag
6080
 
            $$previewInfo{Data} = $self->GetNewValues($Image::ExifTool::Composite{PreviewImage});
 
6094
            $$previewInfo{Data} = $self->GetNewValue($Image::ExifTool::Composite{PreviewImage});
6081
6095
            unless (defined $$previewInfo{Data}) {
6082
6096
                if ($offset >= 0 and $offset + $size <= $$dirInfo{DataLen}) {
6083
6097
                    $$previewInfo{Data} = substr(${$$dirInfo{DataPt}},$offset,$size);