gpst-file

   1 #!/usr/bin/perl -w
   2
   3 #=======================================================================
   4 # $Id$
   5 # File ID: 86736de4-00a1-11de-acc1-000475e441b9
   6 # Generate TAB streams of files with modification time for use with COPY
   7 # in Postgres
   8 #
   9 # Character set: UTF-8
  10 # ©opyleft 2009– Øyvind A. Holm <sunny@sunbase.org>
  11 # License: GNU General Public License version 2 or later, see end of
  12 # file for legal stuff.
  13 #=======================================================================
  14
  15 BEGIN {
  16     our @version_array;
  17 }
  18
  19 use strict;
  20 use Getopt::Long;
  21
  22 BEGIN {
  23     push(@INC, "$ENV{'HOME'}/bin/src/gpstools");
  24     our @version_array;
  25 }
  26
  27 use GPST;
  28 use GPSTxml;
  29
  30 $| = 1;
  31
  32 our $Debug = 0;
  33 our $NA = '\N';
  34 our %Std = (
  35
  36     'output-format' => 'pgtab',
  37     'timezone' => '',
  38
  39 );
  40 our %Opt = (
  41
  42     'author' => '',
  43     'debug' => 0,
  44     'description' => '',
  45     'help' => 0,
  46     'output-format' => $Std{'output-format'},
  47     'strip-whitespace' => 0,
  48     'timezone' => $Std{'timezone'},
  49     'verbose' => 0,
  50     'version' => 0,
  51
  52 );
  53
  54 our $progname = $0;
  55 $progname =~ s/^.*\/(.*?)$/$1/;
  56
  57 my $rcs_id = '$Id$';
  58 my $id_date = $rcs_id;
  59 $id_date =~ s/^.*?\d+ (\d\d\d\d-.*?\d\d:\d\d:\d\d\S+).*/$1/;
  60
  61 push(@main::version_array, $rcs_id);
  62
  63 Getopt::Long::Configure("bundling");
  64 GetOptions(
  65
  66     "author|a=s" => \$Opt{'author'},
  67     "debug" => \$Opt{'debug'},
  68     "description|d=s" => \$Opt{'description'},
  69     "help|h" => \$Opt{'help'},
  70     "output-format|o=s" => \$Opt{'output-format'},
  71     "strip-whitespace|w" => \$Opt{'strip-whitespace'},
  72     "timezone|T=s" => \$Opt{'timezone'},
  73     "verbose|v+" => \$Opt{'verbose'},
  74     "version" => \$Opt{'version'},
  75
  76 ) || die("$progname: Option error. Use -h for help.\n");
  77
  78 $Opt{'debug'} && ($Debug = 1);
  79 $Opt{'help'} && usage(0);
  80 if ($Opt{'version'}) {
  81     print_version();
  82     exit(0);
  83 }
  84
  85 $GPST::Spc = $Opt{'strip-whitespace'} ? "" : " ";
  86 my $Spc = $GPST::Spc; # FIXME
  87 my $tz_str = "";
  88 if (length($Opt{'timezone'})) {
  89     if ($Opt{'timezone'} =~ /^[\+\-][0-2][0-9]{3}$/) {
  90         $tz_str = $Opt{'timezone'};
  91     } elsif ($Opt{'timezone'} =~ /^z$/i) {
  92         $tz_str = $Opt{'timezone'};
  93     } elsif ($Opt{'timezone'} =~ /^[a-z]+$/i) {
  94         $tz_str = " $Opt{'timezone'}";
  95     } else {
  96         die("$progname: $Opt{'timezone'}: Invalid time zone\n");
  97     }
  98     $tz_str = uc($tz_str);
  99 }
 100
 101 if ($Opt{'output-format'} eq "xml") {
 102     print("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<gpstfile>\n");
 103 }
 104
 105 if ($#ARGV < 0) {
 106     while (<>) {
 107         chomp();
 108         print_entry($_);
 109     }
 110 } else {
 111     for my $fname (@ARGV) {
 112         print_entry($fname);
 113     }
 114 }
 115
 116 if ($Opt{'output-format'} eq "xml") {
 117     print("</gpstfile>\n");
 118 }
 119
 120 sub print_entry {
 121     # {{{
 122     my $filename = shift;
 123     my $Retval = 0;
 124     my ($date, $coor) =
 125        ('', '');
 126     D("filename = '$filename'");
 127     if (my @stat_array = stat($filename)) {
 128         my @TA = localtime($stat_array[9]);
 129         $date = sprintf("%04u-%02u-%02uT%02u:%02u:%02u%s",
 130             $TA[5]+1900, $TA[4]+1, $TA[3], $TA[2], $TA[1], $TA[0], $tz_str);
 131         D("tz_str = '$tz_str'");
 132         $filename =~ s/^.*\/(.*?)$/$1/;
 133         my $Output = "";
 134         if ($Opt{'output-format'} eq "xml") {
 135             if (length("$filename$date")) {
 136                 $Output = join("",
 137                     "$Spc$Spc<file>\n",
 138                     length($filename)
 139                         ? sprintf("$Spc$Spc$Spc$Spc<filename>%s</filename>\n",
 140                             txt_to_xml($filename))
 141                         : "",
 142                     length($date)
 143                         ? sprintf("$Spc$Spc$Spc$Spc<date>%s</date>\n",
 144                             txt_to_xml($date))
 145                         : "",
 146                     length($Opt{'description'})
 147                         ? sprintf("$Spc$Spc$Spc$Spc<desc>%s</desc>\n",
 148                             txt_to_xml($Opt{'description'}))
 149                         : "",
 150                     length($Opt{'author'})
 151                         ? sprintf("$Spc$Spc$Spc$Spc<author>%s</author>\n",
 152                             txt_to_xml($Opt{'author'}))
 153                         : "",
 154                     "$Spc$Spc</file>\n",
 155                 );
 156             }
 157         } elsif ($Opt{'output-format'} eq "pgtab") {
 158             # Version information {{{
 159             # Version 1:
 160             #   "1" \t
 161             #   date \t
 162             #   "(lat,lon)"-coordinates \t
 163             #   description \t
 164             #   filename \t
 165             #   author \n
 166             # }}}
 167             $Output = pgtab_entry(
 168                 1, # Version number
 169                 $date,
 170                 $coor,
 171                 $Opt{'description'},
 172                 $filename,
 173                 $Opt{'author'}
 174             );
 175         } else {
 176             die("$progname: $Opt{'output-format'}: Unknown output format\n");
 177         }
 178         print($Output);
 179         $Opt{'verbose'} && print(STDERR $Output);
 180     } else {
 181         warn("$progname: $filename: Cannot stat file: $!\n");
 182     }
 183     return($Retval);
 184     # }}}
 185 } # print_entry()
 186
 187 sub pgtab_entry {
 188     # {{{
 189     my ($Version, $Date, $Coor, $Descr, $Filename, $Author) = @_;
 190     defined($Date)     || ($Date = $NA);
 191     defined($Coor)     || ($Coor = $NA);
 192     defined($Descr)    || ($Descr = $NA);
 193     defined($Filename) || ($Filename = $NA);
 194     defined($Author)   || ($Author = $NA);
 195     my $Retval = "";
 196     if ($Version == 1) {
 197         $Retval = join("\t",
 198             1, # Version number
 199             postgresql_copy_safe($Date),
 200             length($Coor)
 201                 ? postgresql_copy_safe($Coor)
 202                 : $NA,
 203             length($Opt{'description'})
 204                 ? postgresql_copy_safe($Opt{'description'})
 205                 : $NA,
 206             length($Filename)
 207                 ? postgresql_copy_safe($Filename)
 208                 : $NA,
 209             length($Opt{'author'})
 210                 ? postgresql_copy_safe($Opt{'author'})
 211                 : $NA
 212         ) . "\n";
 213     }
 214     return($Retval);
 215     # }}}
 216 } # pgtab_entry()
 217
 218 sub print_version {
 219     # Print program version {{{
 220     for (@main::version_array) {
 221         print("$_\n");
 222     }
 223     # }}}
 224 } # print_version()
 225
 226 sub usage {
 227     # Send the help message to stdout {{{
 228     my $Retval = shift;
 229
 230     if ($Opt{'verbose'}) {
 231         print("\n");
 232         print_version();
 233     }
 234     print(<<END);
 235
 236 Usage: $progname [options] [file [files [...]]]
 237
 238 Generate TAB streams with filenames and file modification time for use
 239 with PostgreSQL’s COPY command. If no filenames are specified on the
 240 command line, file names are read from stdin.
 241
 242 Options:
 243
 244   -a, --author x
 245     Specify author of file.
 246   -d, --description x
 247     Specify description for file.
 248   -h, --help
 249     Show this help.
 250   -v, --verbose
 251     Increase level of verbosity. Can be repeated.
 252   -o x, --output-format x
 253     Create output of type x:
 254       xml
 255       pgtab
 256     Default: "$Std{'output-format'}".
 257   -T X, --timezone X
 258     Prepend X as timezone to the date. Valid formats:
 259       UTC offset
 260         A '+' or '-' followed by a four-digit number (HHMM) which
 261         indicates the offset relative to UTC. Examples:
 262           +0000
 263           -1600
 264           +0630
 265       Time zone abbreviation. Examples:
 266         UTC
 267         Z
 268         CET
 269   -w, --strip-whitespace
 270     Strip all unnecessary whitespace.
 271   --version
 272     Print version information.
 273   --debug
 274     Print debugging messages.
 275
 276 END
 277     exit($Retval);
 278     # }}}
 279 } # usage()
 280
 281 sub msg {
 282     # Print a status message to stderr based on verbosity level {{{
 283     my ($verbose_level, $Txt) = @_;
 284
 285     if ($Opt{'verbose'} >= $verbose_level) {
 286         print(STDERR "$progname: $Txt\n");
 287     }
 288     # }}}
 289 } # msg()
 290
 291 sub D {
 292     # Print a debugging message {{{
 293     $Debug || return;
 294     my @call_info = caller;
 295     chomp(my $Txt = shift);
 296     my $File = $call_info[1];
 297     $File =~ s#\\#/#g;
 298     $File =~ s#^.*/(.*?)$#$1#;
 299     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 300     return("");
 301     # }}}
 302 } # D()
 303
 304 __END__
 305
 306 # Plain Old Documentation (POD) {{{
 307
 308 =pod
 309
 310 =head1 NAME
 311
 312
 313
 314 =head1 REVISION
 315
 316 $Id$
 317
 318 =head1 SYNOPSIS
 319
 320  [options] [file [files [...]]]
 321
 322 =head1 DESCRIPTION
 323
 324
 325
 326 =head1 OPTIONS
 327
 328 =over 4
 329
 330 =item B<-h>, B<--help>
 331
 332 Print a brief help summary.
 333
 334 =item B<-v>, B<--verbose>
 335
 336 Increase level of verbosity. Can be repeated.
 337
 338 =item B<--version>
 339
 340 Print version information.
 341
 342 =item B<--debug>
 343
 344 Print debugging messages.
 345
 346 =back
 347
 348 =head1 BUGS
 349
 350
 351
 352 =head1 AUTHOR
 353
 354 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 355
 356 =head1 COPYRIGHT
 357
 358 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 359 This is free software; see the file F<COPYING> for legalese stuff.
 360
 361 =head1 LICENCE
 362
 363 This program is free software; you can redistribute it and/or modify it
 364 under the terms of the GNU General Public License as published by the
 365 Free Software Foundation; either version 2 of the License, or (at your
 366 option) any later version.
 367
 368 This program is distributed in the hope that it will be useful, but
 369 WITHOUT ANY WARRANTY; without even the implied warranty of
 370 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 371 See the GNU General Public License for more details.
 372
 373 You should have received a copy of the GNU General Public License along
 374 with this program; if not, write to the Free Software Foundation, Inc.,
 375 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 376
 377 =head1 SEE ALSO
 378
 379 =cut
 380
 381 # }}}
 382
 383 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :
 384 # End of file $Id$