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