gpst-pic

   1 #!/usr/bin/perl -w
   2
   3 #=======================================================================
   4 # $Id$
   5 # Extract EXIF data from pictures for use with COPY in Postgres
   6 #
   7 # Character set: UTF-8
   8 # ©opyleft 2008– Øyvind A. Holm <sunny@sunbase.org>
   9 # License: GNU General Public License version 2 or later, see end of
  10 # file for legal stuff.
  11 #=======================================================================
  12
  13 use strict;
  14 use Getopt::Long;
  15
  16 BEGIN {
  17     push(@INC, "$ENV{'HOME'}/bin/src/gpstools");
  18     our @version_array;
  19 }
  20
  21 use GPST;
  22
  23 $| = 1;
  24
  25 our $Debug = 0;
  26 our $NA = '\N';
  27
  28 our %Opt = (
  29     'author' => '',
  30     'debug' => 0,
  31     'description' => '',
  32     'help' => 0,
  33     'verbose' => 0,
  34     'version' => 0,
  35 );
  36
  37 our $progname = $0;
  38 $progname =~ s#^.*/(.*?)$#$1#;
  39
  40 my $rcs_id = '$Id$';
  41 my $id_date = $rcs_id;
  42 $id_date =~ s/^.*?\d+ (\d\d\d\d-.*?\d\d:\d\d:\d\d\S+).*/$1/;
  43
  44 Getopt::Long::Configure("bundling");
  45 GetOptions(
  46     "author|a=s" => \$Opt{'author'},
  47     "debug" => \$Opt{'debug'},
  48     "description|d=s" => \$Opt{'description'},
  49     "help|h" => \$Opt{'help'},
  50     "verbose|v+" => \$Opt{'verbose'},
  51     "version" => \$Opt{'version'},
  52 ) || die("$progname: Option error. Use -h for help.\n");
  53
  54 $Opt{'debug'} && ($Debug = 1);
  55 $Opt{'help'} && usage(0);
  56 $Opt{'version'} && print_version();
  57
  58 if ($#ARGV < 0) {
  59     while (<>) {
  60         chomp();
  61         print_entry($_);
  62     }
  63 } else {
  64     for my $fname (@ARGV) {
  65         print_entry($fname);
  66     }
  67 }
  68
  69 sub print_entry {
  70     my $filename = shift;
  71     my $Retval = 0;
  72     my ($date, $coor) =
  73        ( '',  '');
  74     my @Dates = ();
  75     local *PicFP;
  76     D("filename = '$filename'");
  77     if (open(PicFP, "exifprobe -L \"$filename\" |")) { # FIXME: Quick & Dirty™
  78         while (<PicFP>) {
  79             if (/DateTime/) {
  80                 s/^.*'(.*?)'.*$/$1/;
  81                 chomp($date = $_);
  82                 $date =~ s/^(\d\d\d\d)(.)(\d\d)(.)(\d\d)(.)(\d\d:\d\d:\d\d)(.*)/$1-$3-$5 $7$8/;
  83                 D("date = '$date'");
  84                 push(@Dates, $date);
  85             }
  86         }
  87         close(PicFP);
  88         @Dates = reverse sort @Dates;
  89         $date = $Dates[0];
  90         defined($date) || ($date = '');
  91         D("final date = '$date'");
  92         if ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/) {
  93             $filename =~ s/^.*\/(.*?)$/$1/;
  94             my $Output = join("\t",
  95                 postgresql_copy_safe($date),
  96                 length($coor) ? postgresql_copy_safe($coor) : $NA,
  97                 length($Opt{'description'}) ? postgresql_copy_safe($Opt{'description'}) : $NA,
  98                 length($filename) ? postgresql_copy_safe($filename) : $NA,
  99                 length($Opt{'author'}) ? postgresql_copy_safe($Opt{'author'}) : $NA
 100             ) . "\n";
 101             print($Output);
 102             $Opt{'verbose'} && print(STDERR $Output);
 103         } else {
 104             if (length($date)) {
 105                 warn("$filename: $date: Invalid date format");
 106                 $Retval = 2;
 107             }
 108         }
 109     } else {
 110         warn("$filename: Cannot open exifprobe(1) pipe: $!");
 111         $Retval = 1;
 112     }
 113     return($Retval);
 114 } # print_entry()
 115
 116 sub print_version {
 117     # Print program version {{{
 118     print("$rcs_id\n");
 119     exit(0);
 120     # }}}
 121 } # print_version()
 122
 123 sub usage {
 124     # Send the help message to stdout {{{
 125     my $Retval = shift;
 126
 127     print(<<END);
 128
 129 $rcs_id
 130
 131 Usage: $progname [options] [file [files [...]]]
 132
 133 Extract EXIF info from pictures for use with PostgreSQL's COPY command.
 134 If no filenames are specified on the command line, file names are read
 135 from stdin.
 136
 137 Options:
 138
 139   -a, --author x
 140     Specify author of picture.
 141   -d, --description x
 142     Specify description for picture.
 143   -h, --help
 144     Show this help.
 145   -v, --verbose
 146     Increase level of verbosity. Can be repeated.
 147   --version
 148     Print version information.
 149   --debug
 150     Print debugging messages.
 151
 152 END
 153     exit($Retval);
 154     # }}}
 155 } # usage()
 156
 157 sub msg {
 158     # Print a status message to stderr based on verbosity level {{{
 159     my ($verbose_level, $Txt) = @_;
 160
 161     if ($Opt{'verbose'} >= $verbose_level) {
 162         print(STDERR "$progname: $Txt\n");
 163     }
 164     # }}}
 165 } # msg()
 166
 167 sub D {
 168     # Print a debugging message {{{
 169     $Debug || return;
 170     my @call_info = caller;
 171     chomp(my $Txt = shift);
 172     my $File = $call_info[1];
 173     $File =~ s#\\#/#g;
 174     $File =~ s#^.*/(.*?)$#$1#;
 175     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 176     return("");
 177     # }}}
 178 } # D()
 179
 180 __END__
 181
 182 # Plain Old Documentation (POD) {{{
 183
 184 =pod
 185
 186 =head1 NAME
 187
 188
 189
 190 =head1 REVISION
 191
 192 $Id$
 193
 194 =head1 SYNOPSIS
 195
 196  [options] [file [files [...]]]
 197
 198 =head1 DESCRIPTION
 199
 200
 201
 202 =head1 OPTIONS
 203
 204 =over 4
 205
 206 =item B<-h>, B<--help>
 207
 208 Print a brief help summary.
 209
 210 =item B<-v>, B<--verbose>
 211
 212 Increase level of verbosity. Can be repeated.
 213
 214 =item B<--version>
 215
 216 Print version information.
 217
 218 =item B<--debug>
 219
 220 Print debugging messages.
 221
 222 =back
 223
 224 =head1 BUGS
 225
 226
 227
 228 =head1 AUTHOR
 229
 230 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 231
 232 =head1 COPYRIGHT
 233
 234 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 235 This is free software; see the file F<COPYING> for legalese stuff.
 236
 237 =head1 LICENCE
 238
 239 This program is free software; you can redistribute it and/or modify it
 240 under the terms of the GNU General Public License as published by the
 241 Free Software Foundation; either version 2 of the License, or (at your
 242 option) any later version.
 243
 244 This program is distributed in the hope that it will be useful, but
 245 WITHOUT ANY WARRANTY; without even the implied warranty of
 246 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 247 See the GNU General Public License for more details.
 248
 249 You should have received a copy of the GNU General Public License along
 250 with this program; if not, write to the Free Software Foundation, Inc.,
 251 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 252
 253 =head1 SEE ALSO
 254
 255 =cut
 256
 257 # }}}
 258
 259 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :
 260 # End of file $Id$