afv

#!/usr/bin/env perl

#=======================================================================
# afv
# File ID: 29b2405c-f742-11dd-894f-000475e441b9
# Lagrer alle nye versjoner av en fil.
#
# Character set: UTF-8
# ©opyleft 2001– Øyvind A. Holm <sunny@sunbase.org>
# License: GNU General Public License version 2 or later, see end of 
# file for legal stuff.
#=======================================================================

# FIXME: Finn en standard Perl-måte for å erstatte kjøring av /bin/pwd .

use strict;
use warnings;
use Fcntl ':flock';
use File::Path;
use Digest::MD5;
use Getopt::Long;

$| = 1;

our $Debug = 0;

our %Opt = (

    'debug' => 0,
    'directory' => "",
    'help' => 0,
    'loop' => "",
    'stop' => 0,
    'verbose' => 0,
    'version' => 0,

);

our $progname = $0;
$progname =~ s/^.*\/(.*?)$/$1/;
our $VERSION = "0.00";

Getopt::Long::Configure("bundling");
GetOptions(

    "debug" => \$Opt{'debug'},
    "directory|d=s" => \$Opt{'directory'},
    "help|h" => \$Opt{'help'},
    "loop|l=i" => \$Opt{'loop'},
    "stop|s" => \$Opt{'stop'},
    "verbose|v+" => \$Opt{'verbose'},
    "version" => \$Opt{'version'},

) || die("$progname: Option error. Use -h for help.\n");

$Opt{'debug'} && ($Debug = 1);
$Opt{'help'} && usage(0);
if ($Opt{'version'}) {
    print_version();
    exit(0);
}

unless (length($Opt{'directory'})) {
    defined($ENV{AFVROOT}) || die("AFVROOT er ikke definert");
}

my $Dir = ".AFV";
my $root_dir = length($Opt{'directory'}) ? $Opt{'directory'} : $ENV{AFVROOT};
my $dest_dir = "";
my $curr_dir = "";
my ($do_loop, $sleep_time, $orig_dir) = (0, 5, `/bin/pwd`); # FIXME
chomp($orig_dir);

if ($Opt{'stop'}) {
    chomp($curr_dir = `/bin/pwd`);
    $dest_dir = "$root_dir$curr_dir";
    if (-d "$dest_dir/.") {
        print("Stopper afv’er i $curr_dir...");
        if (open(StopFP, ">$dest_dir/stop")) {
            close(StopFP);
            sleep(5);
            unlink("$dest_dir/stop") || die("$dest_dir/stop: Klarte ikke å slette fila: $!");
            print("OK\n");
            exit(0);
        } else {
            die("$root_dir/stop: Klarte ikke å lage fila: $!");
        }
    } else {
        die("$root_dir: Finner ikke katalogen.");
    }
}

if (length($Opt{'loop'})) {
    if ($Opt{'loop'} =~ /^\d+$/) {
        $do_loop = 1;
        $sleep_time = $Opt{'loop'};
    } else {
        die("Parameteret til -l må være et tall.\n");
    }
}

my @Files = ();
glob_files();

LOOP:
foreach my $FullCurr (@Files) {
    # {{{
    my $Curr = $FullCurr;
    my $another_dir = 0;
    check_stop();
    next LOOP if (!-f $Curr || -l $Curr);
    if ($Curr =~ m#(.*)/(.*?)$#) {
        $another_dir = 1;
        unless (chdir($1)) {
            warn("Klarte ikke chdir(\"$1\"): $!");
            next LOOP;
        }
        $Curr = $2;
    }
    chomp($curr_dir = `/bin/pwd`); # FIXME
    $dest_dir = "$root_dir$curr_dir";
    -d $dest_dir || mkpath($dest_dir, 1) || die("mkpath($dest_dir): $!");
    my $afv_dir = "$dest_dir/$Dir";
    -d $afv_dir || mkpath($afv_dir, 1) || die("mkpath($Dir): $!");
    my $lock_dir = "$afv_dir/$Curr.lock";
    my $lastmd5_file = "$afv_dir/$Curr.lastmd5";
    my $currmd5_file = "$afv_dir/$Curr.currmd5";
    my $start_lock = time;

    until (mkdir($lock_dir, 0777)) {
        warn(sec_to_string(time) . ": $lock_dir: Venter på lockdir, " . (time-$start_lock) . " sekunder");
        my_sleep(5);
    }
    if (open(FromFP, "<$Curr")) {
        binmode(FromFP);
        if (flock(FromFP, LOCK_EX)) {
            # {{{
            my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat(FromFP);
            my $date_str = sec_to_string($mtime);
            my $to_file = "$dest_dir/$date_str.$Curr";
            if (-e $to_file) {
                close(FromFP);
                goto CLEANUP;
            }
            seek(FromFP, 0, 0) || die("$Curr: Klarte ikke å seeke til starten: $!");

            my $curr_md5 = Digest::MD5->new->addfile(*FromFP)->hexdigest;
            D("curr_md5 = $curr_md5");
            open(CurrMD5FP, ">$currmd5_file") || die("$currmd5_file: Klarte ikke å åpne fila for skriving: $!");
            print(CurrMD5FP "$curr_md5\n") || die("$currmd5_file: Feil under skriving til fila. $!");
            close(CurrMD5FP);
            my $last_md5 = "";

            if (-e $lastmd5_file) {
                if (open(LastMD5FP, "<$lastmd5_file")) {
                    chomp($last_md5 = <LastMD5FP>);
                    $last_md5 =~ s/^([0-9a-fA-F]{32})/\L$1\E/;
                    close(LastMD5FP);
                } else {
                    warn("$lastmd5_file: Feil under åpning for lesing: $!");
                }
            }

            D("last_md5 = \"$last_md5\", curr_md5 = \"$curr_md5\"");
            if ($curr_md5 ne $last_md5) {
                print("$date_str.$Curr\n") unless $do_loop;
                if (seek(FromFP, 0, 0)) {
                    if (open(ToFP, ">$to_file")) {
                        if (flock(ToFP, LOCK_EX)) {
                            while (<FromFP>) {
                                print(ToFP $_);
                            }
                        } else {
                            warn("$to_file: Klarte ikke flock(): $!");
                        }
                        close(ToFP);
                        unlink("$lastmd5_file");
                        rename("$currmd5_file", "$lastmd5_file") || die(qq{Klarte ikke rename("$currmd5_file", "$lastmd5_file")});
                    } else {
                        warn("$Curr: Klarte ikke å åpne fila for skriving: $!");
                    }
                } else {
                    warn("$Curr: Klarte ikke å seeke til starten: $!");
                }
            }
            # }}}
        } else {
            warn("$Curr: Klarte ikke flock(): $!");
        }
        close(FromFP);
    } else {
        warn("$Curr: Klarte ikke å åpne fila for lesing: $!");
    }

    CLEANUP:
    rmdir($lock_dir) || warn("$lock_dir: Klarte ikke å fjerne lockdir: $!");
    if ($another_dir) {
        chdir($orig_dir) || die("$orig_dir: Klarte ikke chdir() til originalkatalogen: $!");
    }
    # }}}
}

if ($do_loop) {
    check_stop();
    glob_files();
    my_sleep($sleep_time);
    goto LOOP;
}

exit;

sub sec_to_string {
    # Konverter antall sekunder sia 1970-01-01 00:00:00 GMT til 
    # ååååmmddTttmmssZ
    # {{{
    my @TA = gmtime(shift);
    my $Retval = sprintf("%04u%02u%02uT%02u%02u%02uZ", $TA[5]+1900, $TA[4]+1, $TA[3], $TA[2], $TA[1], $TA[0]);
    return($Retval);
    # }}}
} # sec_to_string()

sub glob_files {
    # Returnerer en array med filnavn som samsvarer med parametrene. {{{
    @Files = ();
    if (scalar(@ARGV)) {
        foreach (@ARGV) {
            push(@Files, glob $_);
        }
    } else {
        while(<>) {
            push(@Files, glob $_);
        }
    }
    # }}}
} # glob_files()

sub check_stop {
    # Sjekk om stop-fila finnes og i så fall avbrytes alt. {{{
    foreach ($root_dir, $dest_dir) {
        if (-e "$_/stop") {
            if (-e "$_/protected") {
                print(STDERR "$curr_dir: $_/stop finnes, men katalogen er beskyttet, så vi avslutter ikke.\n");
            } else {
                print(STDERR "$curr_dir: $_/stop finnes, avslutter.\n");
                exit;
            }
        }
    }
    # }}}
} # check_stop()

sub my_sleep {
    # {{{
    my $Secs = shift;
    my $start_time = time;
    if ($Secs <= 2) {
        check_stop();
        sleep($Secs);
    } else {
        until (time >= $start_time+$Secs) {
            sleep(2);
            check_stop();
        }
    }
    # }}}
} # my_sleep()

sub print_version {
    # Print program version {{{
    print("$progname v$VERSION\n");
    # }}}
} # print_version()

sub usage {
    # Send the help message to stdout {{{
    my $Retval = shift;

    if ($Opt{'verbose'}) {
        print("\n");
        print_version();
    }
    print(<<END);

Syntax: $0 [valg] [fil [flere filer [...]]]

Lagrer flere versjoner av en eller flere filer i katalogen som \$AFVROOT 
er satt til. Hvis ingen filer er spesifisert på kommandolinja, leses 
filnavn fra stdin.

Valg:

  -d X, --directory X
    De forskjellige versjonene skal lagres under X. Overstyrer \$AFVROOT .
  -h, --help
    Show this help.
  -l X, --loop X
    Kjør i loop, sjekk filene hvert X. sekund. Eksempel:

      afv -l5 foo.txt bar.pl &
      find /etc | afv -l 15 &

    for å kjøre den i bakgrunnen. Bruk afvctl(1) for å stoppe afv’er som 
        kjører. Filnavn på filer som lagres blir ikke skrevet ut når 
        "-l"-parameteret brukes.
  -s, --stop
    Stopp afv-looper som kjører i denne katalogen.
  -v, --verbose
    Increase level of verbosity. Can be repeated.
  --version
    Print version information.
  --debug
    Print debugging messages.

Som filnavn kan jokertegn (wildcards) også brukes. Hvis disse escapes, 
brukes den innebygde glob’en og nye filer blir lagt til når den går i 
loop. Eksempel:

  afv -l5 '*' &

sjekker alle filer hvert femte sekund og kjører også ny glob hver gang 
loopen gjentas.

END
    exit($Retval);
    # }}}
} # usage()

sub msg {
    # Print a status message to stderr based on verbosity level {{{
    my ($verbose_level, $Txt) = @_;

    if ($Opt{'verbose'} >= $verbose_level) {
        print(STDERR "$progname: $Txt\n");
    }
    # }}}
} # msg()

sub D {
    # Print a debugging message {{{
    $Debug || return;
    my @call_info = caller;
    chomp(my $Txt = shift);
    my $File = $call_info[1];
    $File =~ s#\\#/#g;
    $File =~ s#^.*/(.*?)$#$1#;
    print(STDERR "$File:$call_info[2] $$ $Txt\n");
    return("");
    # }}}
} # D()

__END__

# Plain Old Documentation (POD) {{{

=pod

=head1 NAME



=head1 SYNOPSIS

 [options] [file [files [...]]]

=head1 DESCRIPTION



=head1 OPTIONS

=over 4

=item B<-h>, B<--help>

Print a brief help summary.

=item B<-v>, B<--verbose>

Increase level of verbosity. Can be repeated.

=item B<--version>

Print version information.

=item B<--debug>

Print debugging messages.

=back

=head1 BUGS



=head1 AUTHOR

Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.

=head1 COPYRIGHT

Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
This is free software; see the file F<COPYING> for legalese stuff.

=head1 LICENCE

This program is free software: you can redistribute it and/or modify it 
under the terms of the GNU General Public License as published by the 
Free Software Foundation, either version 2 of the License, or (at your 
option) any later version.

This program is distributed in the hope that it will be useful, but 
WITHOUT ANY WARRANTY; without even the implied warranty of 
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along 
with this program.
If not, see L<http://www.gnu.org/licenses/>.

=head1 SEE ALSO

=cut

# }}}

# vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :