exif_settime.pl
author Peter Gervai <grin@grin.hu>
Thu, 30 Sep 2021 15:30:10 +0200
changeset 8 31c4ce4d9b73
parent 0 624a9ab34425
permissions -rwxr-xr-x
perlgrok.pl: Fix patternfile; handle perl-incopatible labels * implement per-pattern regex trace
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     1
#!/usr/bin/perl -w
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     2
#
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     3
# set date from exif info
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     4
# $Id: exif_settime.pl,v 1ab5ee663fb1 2011/05/24 06:19:06 grin $
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     5
#
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     6
# (c)2003, Peter Gervai
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     7
#
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     8
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
     9
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    10
use POSIX qw( strftime );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    11
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    12
my $exifprog="exiftags";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    13
my $filepattern = qr/^(.+)\.jpg/i;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    14
my $FNAME = "pic";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    15
my $FEXTENSION = "jpg";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    16
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    17
my $into_current_dir = 1;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    18
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    19
my $DEBUG=0;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    20
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    21
my $dir = $ARGV[0];
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    22
if( !defined($dir) || !-d $dir ) {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    23
    print "hasznalat: $0 <start directory>\n\n";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    24
    exit;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    25
}
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    26
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    27
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    28
my %files;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    29
&walk_files( $dir, '', \%files );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    30
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    31
for my $key (sort keys %files) {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    32
    
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    33
    print "($key) ", $files{$key}[0], '->', $files{$key}[1], "<<\n" if $DEBUG;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    34
    print "mv \"$files{$key}[0]\" \"$files{$key}[1]\"\n";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    35
    
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    36
}
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    37
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    38
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    39
sub walk_files {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    40
    my ($base, $sdir, $rfiles) = @_;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    41
    print "#!/bin/sh\n#Walking dir $base; $sdir...\n";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    42
    
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    43
    if( !-r "$base/$sdir" ) {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    44
        print "#Nem olvashato $base/$sdir!\n";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    45
        return undef;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    46
    }
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    47
    
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    48
    opendir( D, "$base/$sdir" );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    49
    my @entries = grep { !/^\.\.?$/ } readdir( D );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    50
    closedir( D );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    51
    foreach my $entry (@entries) {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    52
        if( -f "$base/$sdir/$entry" && $entry =~ /$filepattern/ ) {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    53
            # process file
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    54
            my $time = &get_newtime( "$base/$sdir", $entry, $1 );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    55
            
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    56
            print "touch -d '$time' $base/$sdir/$entry\n";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    57
        }
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    58
    }
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    59
}
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    60
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    61
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    62
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    63
sub get_newtime {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    64
    my ($base, $entry, $basename) = @_;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    65
    my $time = &get_exif_time( "$base/$entry" );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    66
    
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    67
    return $time;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    68
}
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    69
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    70
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    71
sub get_exif_time {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    72
    my $file = shift;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    73
    
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    74
    if( -f $file ) {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    75
        my $res = qx( $exifprog "$file" 2> /dev/null );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    76
        if( $res =~ m/Image Created: (\S+ \S+)/ ) {
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    77
            #print "res=$_>>$1<<\n";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    78
            # s m h md m y
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    79
            my @d = split /[: ]/, $1;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    80
            #print "mon:", join(",", @d) , "<<\n";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    81
            $d[1] -= 1;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    82
            $d[0] -= 1900;
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    83
            return strftime("%Y-%m-%d %H:%M:%S",  @d[5,4,3,2,1,0] );
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    84
        }
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    85
    }
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    86
    return "today";
624a9ab34425 Add code lying around to the repo
Peter Gervai <grin@grin.hu>
parents:
diff changeset
    87
}