#!/usr/local/bin/perl -w
my $RCS_Id = '$Id: PsiBackup.pl,v 1.6 1997-04-05 18:40:43+02 jv Exp $ ';

# Author          : Johan Vromans
# Created On      : Tue Sep 15 15:59:04 1992
# Last Modified By: Johan Vromans
# Last Modified On: Fri Apr  4 10:06:51 1997
# Update Count    : 151
# Status          : Unknown, Use with caution!

=head1 NAME

PsiBackup - backup an NFS mounted Psion.

=head1 SYNOPSIS

B<perl -w PsiBackup.pl> [options]

=head1 DESCRIPTION

B<PsiBackup> backs up a Psion Series 3a organizer, mounted to a Unix
system using NFS. The conventions used in file names are identical to
the conventions of Psion's B<PsiWin> and B<RCOM> programs.

B<IMPORTANT:> Before starting the back up, all Psion tasks that use
files on the disk to be backed up should be manually stopped.

=head2 Options

=over 5

=item B<-mount> I<dir>

The NFS mount point for the Psion. The default value F</psion.std/mnt>
corresponds to the default name used by B<p3nfsd>.

=item B<-backup> I<dir>

The destination directory for the backup, e.g. F</@psion>. The names of
the Psion and the disk will be appended to it to form the actual name
of the backup directory.

=item B<-name> I<name>

Optionally, the name of this Psion system. Useful if you want to
backup several organizers in the same backup directory.

=item B<-disk> I<name>

Identification of the Psion disk to back up. Possible values are F<i>
(default, the internal disk), F<a> and F<b> (the SSD's),
F<c> (the 3-Link ROM) and F<r> (the Psion's internal ROM).

=item B<->[no]B<archive>

Do [not] archive old versions of files under a F<@archive> tree.
Archiving is default enabled for the disks, and disabled for the ROMs.

=item B<-limit> I<nn>

Limit the number of archive copies to I<nn> versions. Default is 16.
Note that B<RCOM> maintains only one copy, and B<PsiWin> allows up
to 3 copies.

=item B<-help>

A short help for the B<PsiBackup> command.

=item B<-ident>

Show the program identification.

=item B<-verbose>

Supply verbose progress information during the process. 

=item B<-quiet>

Supply no progress information during the process. 

=back

=head1 ENVIRONMENT

B<PsiBackup> uses no environment variables.

=head1 AUTHOR

Johan Vromans E<lt>F<jvromans@squirrel.nl>E<gt>

=head1 BUGS

The program can not stop active applications on the Psion, nor can it
check the Psion's owner information to verify that the correct
organizer is being backed up.

=cut

################ Common stuff ################

# $LIBDIR = $ENV{'LIBDIR'} || '/usr/local/lib/sample';
# unshift (@INC, $LIBDIR);
# require 'common.pl';
use strict;
my $my_package = 'Sciurix';
my ($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
$my_version .= '*' if length('$Locker:  $ ') > 12;

################ Program parameters ################

# The Psion's mount pount. DO *NOT* specify the disk here.
my $src_dir = "/psion.std/mnt";
# The backup tree. Do *NOT* specify the Psion name and disk here.
my $backup_dir = "/\@psion";
# The archive dir. Will be overwritten later.
my $archive_dir = '/@archive';

use Carp;
use Getopt::Long 2.00;
use DirHandle;
use File::Basename qw (dirname);
sub sys (@);

my $archive = 1;		# archive obsolete files
my $limit = 16;			# max. number of backup copies to retain
my $drive = 'i';		# disk to back up
my $name = '';			# optional name of the Psion to back up

my $totfiles = 0;
my $totnew = 0;
my $totbackedup = 0;
my $totobsolete = 0;

my $verbose = 0;
my $quiet = 0;
my ($debug, $trace, $test) = (0, 0, 0);
options ();
$verbose = 0 if $quiet;
$trace |= $debug;
$verbose |= $trace;

################ The Process ################

# Append psion name and disk to the directories.
if ( $drive eq 'r' ) {
    $src_dir .= '/rom::';
}
else {
    $src_dir .= '/loc::' . ($drive eq 'i' ? 'm' : $drive) . ':';
}
unless ( -d $src_dir ) {
    print STDERR ("Source directory $src_dir does not exist.\n",
		  "Backup aborted.\n");
    exit (1);
}
$backup_dir .= '/' . $name unless $name eq '';
unless ( -d $backup_dir ) {
    print STDERR ("Backup directory $backup_dir does not exist.\n",
		  "Create manually before proceeding.\n");
    exit (1);
}

$backup_dir .= '/' . $drive;
$archive_dir = $backup_dir . '/@archive';

# No archiving for ROM and 3-Link.
$archive = 0 if $drive =~ /^[rc]$/;

# Do the backup.
do_backup ($src_dir);

if ( $verbose ) {
    print STDERR ("Total: ", $totfiles, 
		  $totfiles == 1 ? " file" : " files",
		  $totbackedup > 0 ? ", $totbackedup backed up" : "",
		  $totnew > 0 ? " ($totnew new)" : "",
		  $totobsolete > 0 ? ", $totobsolete obsolete" : "",
		  ".\n");
}

exit 0;

################ Subroutines ################

sub do_backup ($) {
    my ($src) = @_;
    my $f;

    print STDERR ("Processing directory $src ... ") if $verbose;

    # Read the source directory, build file and directory lists.
    my $dir = new DirHandle ($src);
    unless ( defined $dir ) {
	carp ("Cannot access $src: $!\n");
	return;
    }

    my %flist = ();
    my @dlist = ();
    while ( defined ($f = $dir->read) ) {
	next if $f eq '.' or $f eq '..';
	my @st = stat ("$src/$f");
	unless ( defined @st and @st > 0 ) {
	    carp ("Cannot stat source $src/$f: $!\n");
	    next;
	}
	# Push directories, for files save the stat info.
	if ( -d _ ) {
	    push (@dlist, "$src/$f");
	}
	else {
	    $flist{"$src/$f"} = [ @st ];
	}
    }

    if ( $verbose ) {
	my $nfiles = scalar (keys (%flist));
	my $ndirs = scalar (@dlist);
	print STDERR ($nfiles, $nfiles == 1 ? " file" : " files") 
	  if $nfiles;
	print STDERR (", ") if $nfiles and $ndirs;
	print STDERR ($ndirs, " director", $ndirs == 1 ? "y" : "ies")
	  if $ndirs;
	print STDERR (".") if $nfiles or $ndirs;
	print STDERR ("\n");
	$totfiles += $nfiles;
    }

    print STDERR ("dlist = @dlist\n") if $debug;
    print STDERR ("flist = ", join(" ", sort(keys(%flist))), "\n") if $debug;

    # Read the backup directory, same procedure.
    my $dst = backup_name ($src);
    my %bflist = ();
    my %bdlist = ();
    $dir = new DirHandle ($dst);
    if ( defined $dir ) {
	while ( defined ($f = $dir->read) ) {
	    next if $f eq '.' or $f eq '..' or $f eq '@archive';
	    my @st = stat ("$dst/$f");
	    unless ( defined @st and @st > 0 ) {
		carp ("Cannot stat $dst/$f: $!\n");
		next;
	    }
	    if ( -d _ ) {
		$bdlist{"$dst/$f"} = 1;
	    }
	    else {
		$bflist{"$dst/$f"} = [ @st ];
	    }
	}
	
	print STDERR ("bdlist = ",
		      join(" ", sort(keys(%bdlist))), "\n") if $debug;
	print STDERR ("bflist = ", 
		      join(" ", sort(keys(%bflist))), "\n") if $debug;
    }

    # Process the files from the source.
    foreach $f ( sort (keys (%flist)) ) {
	backup ($f, $flist{$f});
	# If found, delete from the backup list.
	delete $bflist{backup_name($f)};
    }

    # Process the directories.
    foreach $f ( sort (@dlist) ) {
	do_backup ($f);
	# If found, delete from the backup list.
	delete $bdlist{backup_name($f)};
    }

    # Remove obsolete files from the backup.
    foreach $f ( sort (keys (%bflist)) ) {
	if ( $archive ) {
	    archive ($f, $archive_dir . substr ($f, length($backup_dir)));
	}
	else {
	    print STDERR ("Removing $f\n") if $verbose;
	    sys ("rm", $f);
	}
	$totobsolete++;
    }

    # Remove obsolete directories.
    foreach $f ( reverse (sort (keys (%bdlist))) ) {
	print STDERR ("Removing $f\n") if $verbose;
	sys ("rmdir", $f);
    }
}

# Build backup name for a file.
sub backup_name ($) {
    $backup_dir . substr($_[0], length($src_dir));
}

# Build archive name for a file.
sub archive_name ($) {
    $archive_dir . substr($_[0], length($src_dir));
}

# Backup a file, if needed.
sub backup ($$) {
    my ($src,$st) = @_;
    my $dst = backup_name ($src);

    print STDERR ("=> try $src\n") if $debug;

    my @st = stat ($dst);	# extraneous -- but out of reach...
    my $need = '';

    if ( defined @st and @st > 0 ) {
	if ( $st[7] != $st->[7] ) {
	    $need = "size differs $st[7] -> $st->[7]";
	}
	if ( $st[9] != $st->[9] ) {
	    $need .= "\n   and " if $need;
	    $need .= "mtime differs ".localtime($st[9])." -> ".
	      localtime($st->[9]);
	}
    }
    else {
	$need = 'new file';
	$totnew++;
    }
    return if $need eq '';
    $totbackedup++;
    print STDERR ("Processing file $src: $need\n") if $trace;

    if ( $archive and -f $dst ) {
	archive ($dst, archive_name($src));
    }
    print STDERR ("Backing up $src => $dst\n")
      unless $quiet;
    my $dir = dirname ($dst);
    sys ("mkdir", "-p", $dir) unless -d $dir;
    sys ("cp", $src, $dst);
    utime (time, $st->[9], $dst) or carp ("utime $dst: $!\n");
}

# Archive a file, moving up older copies.
# sequence is
#   foo.bar -> @archive/foo.bar
#   @archive/foo.bar -> @archive/@a.002/foo.bar
#   @archive/@a.002/foo.bar -> @archive/@a.003/foo.bar
#   ...etc...
sub archive ($$) {
    my ($src, $dst) = @_;
    print STDERR ("Archiving ", $src, "\n") if $verbose;
    my $dir;
    if ( -f $dst and $limit > 0 ) {
	moveup ($dst, 1);
    }
    $dir = dirname ($dst);
    sys ("mkdir", "-p", $dir) unless -d $dir;
    sys ("mv", $src, $dst);
}

# Move /path/@archive/@a.(N)/foo.bar -> /path/@archive/@a.(N+1)/foo.bar
# Input name is /path/@archive/foo.bar.
# N = 1 -> source is /path/@archive/foo.bar.
sub moveup ($$) {
    my ($dst, $i) = @_;
    my ($old, $new);
    $old = $dst;
    $old =~ s:/\@archive/:sprintf("%s\@a.%03d/",$&,$i):e if $i > 1;
    ($new = $dst) =~ s:/\@archive/:sprintf("%s\@a.%03d/",$&,$i+1):e;
    if ( -f $new and $i < $limit ) {
	moveup ($dst, $i+1);
    }
    print STDERR ("Moving up $old\n") if $verbose;
    my $dir = dirname ($new);
    sys ("mkdir", "-p", $dir) unless -d $dir;
    sys ("mv", $old, $new);
}

# Adviced system command.
sub sys (@) {
    my (@cmd) = @_;
    print STDERR ("+ @cmd\n") if $trace;
    my $ret = 0;
    $ret = system (@cmd);
    print STDERR ("=> ret = $ret from \"@cmd\"\n") unless $ret == 0;
    exit (255) if $ret == 2 or $ret == 3; # INT and QUIT
    $ret;
}

# Command line options.
sub options () {
    my $help = 0;		# handled locally
    my $ident = 0;		# handled locally

    # Process options.
    if ( @ARGV > 0 && $ARGV[0] =~ /^[-+]/ ) {
	usage (1)
	    unless GetOptions ('ident' => \$ident,
			       'name=s' => \$name,
			       'mount=s' => \$src_dir,
			       'backup=s' => \$backup_dir,
			       'disk=s' => \$drive,
			       'archive!' => \$archive,
			       'limit=i' => $limit,
			       'verbose' => \$verbose,
			       'quiet' => \$quiet,
			       'trace' => \$trace,
			       'help' => \$help,
			       'debug' => \$debug)
	      && !$help;
    }
    print STDERR ("This is $my_package [$my_name $my_version]\n")
	if $ident;

    $drive = lc ($drive);
    usage (1)
      unless $drive =~ /^[iabcr]$/;
}

# Usage.
sub usage ($) {
    my ($xit) = @_;
    print STDERR <<EndOfUsage;
This is $my_package [$my_name $my_version]
Usage: $0 [options] [file ...]
    -mount XXX		NFS mounted Psion dir, e.g. $src_dir
    -backup XXX		destination dir, e.g. $backup_dir
    -name XXX		optional name of this Psion
    -disk M		the Psion disk: 'i' (default), 'a', 'b',
                        'c' (3-Link) or 'r' (ROM)
    -[no]archive	do [not] archive old versions
    -limit NN		limit archive to NN versions
    -help		this message
    -ident		show identification
    -verbose		verbose progress information
    -quiet		no progress information
EndOfUsage
    exit $xit if defined $xit and $xit != 0;
}