afv

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # afv
   5 # File ID: 29b2405c-f742-11dd-894f-000475e441b9
   6 # Lagrer alle nye versjoner av en fil.
   7 #
   8 # Character set: UTF-8
   9 # ©opyleft 2001– Øyvind A. Holm <sunny@sunbase.org>
  10 # License: GNU General Public License version 2 or later, see end of
  11 # file for legal stuff.
  12 #=======================================================================
  13
  14 # FIXME: Finn en standard Perl-måte for å erstatte kjøring av /bin/pwd .
  15
  16 use strict;
  17 use warnings;
  18 use Fcntl ':flock';
  19 use File::Path;
  20 use Digest::MD5;
  21 use Getopt::Long;
  22
  23 $| = 1;
  24
  25 our $Debug = 0;
  26
  27 our %Opt = (
  28
  29     'debug' => 0,
  30     'directory' => "",
  31     'help' => 0,
  32     'loop' => "",
  33     'stop' => 0,
  34     'verbose' => 0,
  35     'version' => 0,
  36
  37 );
  38
  39 our $progname = $0;
  40 $progname =~ s/^.*\/(.*?)$/$1/;
  41 our $VERSION = "0.00";
  42
  43 Getopt::Long::Configure("bundling");
  44 GetOptions(
  45
  46     "debug" => \$Opt{'debug'},
  47     "directory|d=s" => \$Opt{'directory'},
  48     "help|h" => \$Opt{'help'},
  49     "loop|l=i" => \$Opt{'loop'},
  50     "stop|s" => \$Opt{'stop'},
  51     "verbose|v+" => \$Opt{'verbose'},
  52     "version" => \$Opt{'version'},
  53
  54 ) || die("$progname: Option error. Use -h for help.\n");
  55
  56 $Opt{'debug'} && ($Debug = 1);
  57 $Opt{'help'} && usage(0);
  58 if ($Opt{'version'}) {
  59     print_version();
  60     exit(0);
  61 }
  62
  63 unless (length($Opt{'directory'})) {
  64     defined($ENV{AFVROOT}) || die("AFVROOT er ikke definert");
  65 }
  66
  67 my $Dir = ".AFV";
  68 my $root_dir = length($Opt{'directory'}) ? $Opt{'directory'} : $ENV{AFVROOT};
  69 my $dest_dir = "";
  70 my $curr_dir = "";
  71 my ($do_loop, $sleep_time, $orig_dir) = (0, 5, `/bin/pwd`); # FIXME
  72 chomp($orig_dir);
  73
  74 if ($Opt{'stop'}) {
  75     chomp($curr_dir = `/bin/pwd`);
  76     $dest_dir = "$root_dir$curr_dir";
  77     if (-d "$dest_dir/.") {
  78         print("Stopper afv’er i $curr_dir...");
  79         if (open(StopFP, ">$dest_dir/stop")) {
  80             close(StopFP);
  81             sleep(5);
  82             unlink("$dest_dir/stop") || die("$dest_dir/stop: Klarte ikke å slette fila: $!");
  83             print("OK\n");
  84             exit(0);
  85         } else {
  86             die("$root_dir/stop: Klarte ikke å lage fila: $!");
  87         }
  88     } else {
  89         die("$root_dir: Finner ikke katalogen.");
  90     }
  91 }
  92
  93 if (length($Opt{'loop'})) {
  94     if ($Opt{'loop'} =~ /^\d+$/) {
  95         $do_loop = 1;
  96         $sleep_time = $Opt{'loop'};
  97     } else {
  98         die("Parameteret til -l må være et tall.\n");
  99     }
 100 }
 101
 102 my @Files = ();
 103 glob_files();
 104
 105 LOOP:
 106 foreach my $FullCurr (@Files) {
 107     # {{{
 108     my $Curr = $FullCurr;
 109     my $another_dir = 0;
 110     check_stop();
 111     next LOOP if (!-f $Curr || -l $Curr);
 112     if ($Curr =~ m#(.*)/(.*?)$#) {
 113         $another_dir = 1;
 114         unless (chdir($1)) {
 115             warn("Klarte ikke chdir(\"$1\"): $!");
 116             next LOOP;
 117         }
 118         $Curr = $2;
 119     }
 120     chomp($curr_dir = `/bin/pwd`); # FIXME
 121     $dest_dir = "$root_dir$curr_dir";
 122     -d $dest_dir || mkpath($dest_dir, 1) || die("mkpath($dest_dir): $!");
 123     my $afv_dir = "$dest_dir/$Dir";
 124     -d $afv_dir || mkpath($afv_dir, 1) || die("mkpath($Dir): $!");
 125     my $lock_dir = "$afv_dir/$Curr.lock";
 126     my $lastmd5_file = "$afv_dir/$Curr.lastmd5";
 127     my $currmd5_file = "$afv_dir/$Curr.currmd5";
 128     my $start_lock = time;
 129
 130     until (mkdir($lock_dir, 0777)) {
 131         warn(sec_to_string(time) . ": $lock_dir: Venter på lockdir, " . (time-$start_lock) . " sekunder");
 132         my_sleep(5);
 133     }
 134     if (open(FromFP, "<$Curr")) {
 135         binmode(FromFP);
 136         if (flock(FromFP, LOCK_EX)) {
 137             # {{{
 138             my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat(FromFP);
 139             my $date_str = sec_to_string($mtime);
 140             my $to_file = "$dest_dir/$date_str.$Curr";
 141             if (-e $to_file) {
 142                 close(FromFP);
 143                 goto CLEANUP;
 144             }
 145             seek(FromFP, 0, 0) || die("$Curr: Klarte ikke å seeke til starten: $!");
 146
 147             my $curr_md5 = Digest::MD5->new->addfile(*FromFP)->hexdigest;
 148             D("curr_md5 = $curr_md5");
 149             open(CurrMD5FP, ">$currmd5_file") || die("$currmd5_file: Klarte ikke å åpne fila for skriving: $!");
 150             print(CurrMD5FP "$curr_md5\n") || die("$currmd5_file: Feil under skriving til fila. $!");
 151             close(CurrMD5FP);
 152             my $last_md5 = "";
 153
 154             if (-e $lastmd5_file) {
 155                 if (open(LastMD5FP, "<$lastmd5_file")) {
 156                     chomp($last_md5 = <LastMD5FP>);
 157                     $last_md5 =~ s/^([0-9a-fA-F]{32})/\L$1\E/;
 158                     close(LastMD5FP);
 159                 } else {
 160                     warn("$lastmd5_file: Feil under åpning for lesing: $!");
 161                 }
 162             }
 163
 164             D("last_md5 = \"$last_md5\", curr_md5 = \"$curr_md5\"");
 165             if ($curr_md5 ne $last_md5) {
 166                 print("$date_str.$Curr\n") unless $do_loop;
 167                 if (seek(FromFP, 0, 0)) {
 168                     if (open(ToFP, ">$to_file")) {
 169                         if (flock(ToFP, LOCK_EX)) {
 170                             while (<FromFP>) {
 171                                 print(ToFP $_);
 172                             }
 173                         } else {
 174                             warn("$to_file: Klarte ikke flock(): $!");
 175                         }
 176                         close(ToFP);
 177                         unlink("$lastmd5_file");
 178                         rename("$currmd5_file", "$lastmd5_file") || die(qq{Klarte ikke rename("$currmd5_file", "$lastmd5_file")});
 179                     } else {
 180                         warn("$Curr: Klarte ikke å åpne fila for skriving: $!");
 181                     }
 182                 } else {
 183                     warn("$Curr: Klarte ikke å seeke til starten: $!");
 184                 }
 185             }
 186             # }}}
 187         } else {
 188             warn("$Curr: Klarte ikke flock(): $!");
 189         }
 190         close(FromFP);
 191     } else {
 192         warn("$Curr: Klarte ikke å åpne fila for lesing: $!");
 193     }
 194
 195     CLEANUP:
 196     rmdir($lock_dir) || warn("$lock_dir: Klarte ikke å fjerne lockdir: $!");
 197     if ($another_dir) {
 198         chdir($orig_dir) || die("$orig_dir: Klarte ikke chdir() til originalkatalogen: $!");
 199     }
 200     # }}}
 201 }
 202
 203 if ($do_loop) {
 204     check_stop();
 205     glob_files();
 206     my_sleep($sleep_time);
 207     goto LOOP;
 208 }
 209
 210 exit;
 211
 212 sub sec_to_string {
 213     # Konverter antall sekunder sia 1970-01-01 00:00:00 GMT til
 214     # ååååmmddTttmmssZ
 215     # {{{
 216     my @TA = gmtime(shift);
 217     my $Retval = sprintf("%04u%02u%02uT%02u%02u%02uZ", $TA[5]+1900, $TA[4]+1, $TA[3], $TA[2], $TA[1], $TA[0]);
 218     return($Retval);
 219     # }}}
 220 } # sec_to_string()
 221
 222 sub glob_files {
 223     # Returnerer en array med filnavn som samsvarer med parametrene. {{{
 224     @Files = ();
 225     if (scalar(@ARGV)) {
 226         foreach (@ARGV) {
 227             push(@Files, glob $_);
 228         }
 229     } else {
 230         while(<>) {
 231             push(@Files, glob $_);
 232         }
 233     }
 234     # }}}
 235 } # glob_files()
 236
 237 sub check_stop {
 238     # Sjekk om stop-fila finnes og i så fall avbrytes alt. {{{
 239     foreach ($root_dir, $dest_dir) {
 240         if (-e "$_/stop") {
 241             if (-e "$_/protected") {
 242                 print(STDERR "$curr_dir: $_/stop finnes, men katalogen er beskyttet, så vi avslutter ikke.\n");
 243             } else {
 244                 print(STDERR "$curr_dir: $_/stop finnes, avslutter.\n");
 245                 exit;
 246             }
 247         }
 248     }
 249     # }}}
 250 } # check_stop()
 251
 252 sub my_sleep {
 253     # {{{
 254     my $Secs = shift;
 255     my $start_time = time;
 256     if ($Secs <= 2) {
 257         check_stop();
 258         sleep($Secs);
 259     } else {
 260         until (time >= $start_time+$Secs) {
 261             sleep(2);
 262             check_stop();
 263         }
 264     }
 265     # }}}
 266 } # my_sleep()
 267
 268 sub print_version {
 269     # Print program version {{{
 270     print("$progname v$VERSION\n");
 271     # }}}
 272 } # print_version()
 273
 274 sub usage {
 275     # Send the help message to stdout {{{
 276     my $Retval = shift;
 277
 278     if ($Opt{'verbose'}) {
 279         print("\n");
 280         print_version();
 281     }
 282     print(<<END);
 283
 284 Syntax: $0 [valg] [fil [flere filer [...]]]
 285
 286 Lagrer flere versjoner av en eller flere filer i katalogen som \$AFVROOT
 287 er satt til. Hvis ingen filer er spesifisert på kommandolinja, leses
 288 filnavn fra stdin.
 289
 290 Valg:
 291
 292   -d X, --directory X
 293     De forskjellige versjonene skal lagres under X. Overstyrer \$AFVROOT .
 294   -h, --help
 295     Show this help.
 296   -l X, --loop X
 297     Kjør i loop, sjekk filene hvert X. sekund. Eksempel:
 298
 299       afv -l5 foo.txt bar.pl &
 300       find /etc | afv -l 15 &
 301
 302     for å kjøre den i bakgrunnen. Bruk afvctl(1) for å stoppe afv’er som
 303         kjører. Filnavn på filer som lagres blir ikke skrevet ut når
 304         "-l"-parameteret brukes.
 305   -s, --stop
 306     Stopp afv-looper som kjører i denne katalogen.
 307   -v, --verbose
 308     Increase level of verbosity. Can be repeated.
 309   --version
 310     Print version information.
 311   --debug
 312     Print debugging messages.
 313
 314 Som filnavn kan jokertegn (wildcards) også brukes. Hvis disse escapes,
 315 brukes den innebygde glob’en og nye filer blir lagt til når den går i
 316 loop. Eksempel:
 317
 318   afv -l5 '*' &
 319
 320 sjekker alle filer hvert femte sekund og kjører også ny glob hver gang
 321 loopen gjentas.
 322
 323 END
 324     exit($Retval);
 325     # }}}
 326 } # usage()
 327
 328 sub msg {
 329     # Print a status message to stderr based on verbosity level {{{
 330     my ($verbose_level, $Txt) = @_;
 331
 332     if ($Opt{'verbose'} >= $verbose_level) {
 333         print(STDERR "$progname: $Txt\n");
 334     }
 335     # }}}
 336 } # msg()
 337
 338 sub D {
 339     # Print a debugging message {{{
 340     $Debug || return;
 341     my @call_info = caller;
 342     chomp(my $Txt = shift);
 343     my $File = $call_info[1];
 344     $File =~ s#\\#/#g;
 345     $File =~ s#^.*/(.*?)$#$1#;
 346     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 347     return("");
 348     # }}}
 349 } # D()
 350
 351 __END__
 352
 353 # Plain Old Documentation (POD) {{{
 354
 355 =pod
 356
 357 =head1 NAME
 358
 359
 360
 361 =head1 SYNOPSIS
 362
 363  [options] [file [files [...]]]
 364
 365 =head1 DESCRIPTION
 366
 367
 368
 369 =head1 OPTIONS
 370
 371 =over 4
 372
 373 =item B<-h>, B<--help>
 374
 375 Print a brief help summary.
 376
 377 =item B<-v>, B<--verbose>
 378
 379 Increase level of verbosity. Can be repeated.
 380
 381 =item B<--version>
 382
 383 Print version information.
 384
 385 =item B<--debug>
 386
 387 Print debugging messages.
 388
 389 =back
 390
 391 =head1 BUGS
 392
 393
 394
 395 =head1 AUTHOR
 396
 397 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 398
 399 =head1 COPYRIGHT
 400
 401 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 402 This is free software; see the file F<COPYING> for legalese stuff.
 403
 404 =head1 LICENCE
 405
 406 This program is free software: you can redistribute it and/or modify it
 407 under the terms of the GNU General Public License as published by the
 408 Free Software Foundation, either version 2 of the License, or (at your
 409 option) any later version.
 410
 411 This program is distributed in the hope that it will be useful, but
 412 WITHOUT ANY WARRANTY; without even the implied warranty of
 413 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 414 See the GNU General Public License for more details.
 415
 416 You should have received a copy of the GNU General Public License along
 417 with this program.
 418 If not, see L<http://www.gnu.org/licenses/>.
 419
 420 =head1 SEE ALSO
 421
 422 =cut
 423
 424 # }}}
 425
 426 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :