home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / 1997 / 982 / PSIBACKU.PL next >
Encoding:
Perl Script  |  1997-04-05  |  11.1 KB  |  438 lines
  1. #!/usr/local/bin/perl -w
  2. my $RCS_Id = '$Id: PsiBackup.pl,v 1.6 1997-04-05 18:40:43+02 jv Exp $ ';
  3.  
  4. # Author          : Johan Vromans
  5. # Created On      : Tue Sep 15 15:59:04 1992
  6. # Last Modified By: Johan Vromans
  7. # Last Modified On: Fri Apr  4 10:06:51 1997
  8. # Update Count    : 151
  9. # Status          : Unknown, Use with caution!
  10.  
  11. =head1 NAME
  12.  
  13. PsiBackup - backup an NFS mounted Psion.
  14.  
  15. =head1 SYNOPSIS
  16.  
  17. B<perl -w PsiBackup.pl> [options]
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. B<PsiBackup> backs up a Psion Series 3a organizer, mounted to a Unix
  22. system using NFS. The conventions used in file names are identical to
  23. the conventions of Psion's B<PsiWin> and B<RCOM> programs.
  24.  
  25. B<IMPORTANT:> Before starting the back up, all Psion tasks that use
  26. files on the disk to be backed up should be manually stopped.
  27.  
  28. =head2 Options
  29.  
  30. =over 5
  31.  
  32. =item B<-mount> I<dir>
  33.  
  34. The NFS mount point for the Psion. The default value F</psion.std/mnt>
  35. corresponds to the default name used by B<p3nfsd>.
  36.  
  37. =item B<-backup> I<dir>
  38.  
  39. The destination directory for the backup, e.g. F</@psion>. The names of
  40. the Psion and the disk will be appended to it to form the actual name
  41. of the backup directory.
  42.  
  43. =item B<-name> I<name>
  44.  
  45. Optionally, the name of this Psion system. Useful if you want to
  46. backup several organizers in the same backup directory.
  47.  
  48. =item B<-disk> I<name>
  49.  
  50. Identification of the Psion disk to back up. Possible values are F<i>
  51. (default, the internal disk), F<a> and F<b> (the SSD's),
  52. F<c> (the 3-Link ROM) and F<r> (the Psion's internal ROM).
  53.  
  54. =item B<->[no]B<archive>
  55.  
  56. Do [not] archive old versions of files under a F<@archive> tree.
  57. Archiving is default enabled for the disks, and disabled for the ROMs.
  58.  
  59. =item B<-limit> I<nn>
  60.  
  61. Limit the number of archive copies to I<nn> versions. Default is 16.
  62. Note that B<RCOM> maintains only one copy, and B<PsiWin> allows up
  63. to 3 copies.
  64.  
  65. =item B<-help>
  66.  
  67. A short help for the B<PsiBackup> command.
  68.  
  69. =item B<-ident>
  70.  
  71. Show the program identification.
  72.  
  73. =item B<-verbose>
  74.  
  75. Supply verbose progress information during the process. 
  76.  
  77. =item B<-quiet>
  78.  
  79. Supply no progress information during the process. 
  80.  
  81. =back
  82.  
  83. =head1 ENVIRONMENT
  84.  
  85. B<PsiBackup> uses no environment variables.
  86.  
  87. =head1 AUTHOR
  88.  
  89. Johan Vromans E<lt>F<jvromans@squirrel.nl>E<gt>
  90.  
  91. =head1 BUGS
  92.  
  93. The program can not stop active applications on the Psion, nor can it
  94. check the Psion's owner information to verify that the correct
  95. organizer is being backed up.
  96.  
  97. =cut
  98.  
  99. ################ Common stuff ################
  100.  
  101. # $LIBDIR = $ENV{'LIBDIR'} || '/usr/local/lib/sample';
  102. # unshift (@INC, $LIBDIR);
  103. # require 'common.pl';
  104. use strict;
  105. my $my_package = 'Sciurix';
  106. my ($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
  107. $my_version .= '*' if length('$Locker:  $ ') > 12;
  108.  
  109. ################ Program parameters ################
  110.  
  111. # The Psion's mount pount. DO *NOT* specify the disk here.
  112. my $src_dir = "/psion.std/mnt";
  113. # The backup tree. Do *NOT* specify the Psion name and disk here.
  114. my $backup_dir = "/\@psion";
  115. # The archive dir. Will be overwritten later.
  116. my $archive_dir = '/@archive';
  117.  
  118. use Carp;
  119. use Getopt::Long 2.00;
  120. use DirHandle;
  121. use File::Basename qw (dirname);
  122. sub sys (@);
  123.  
  124. my $archive = 1;        # archive obsolete files
  125. my $limit = 16;            # max. number of backup copies to retain
  126. my $drive = 'i';        # disk to back up
  127. my $name = '';            # optional name of the Psion to back up
  128.  
  129. my $totfiles = 0;
  130. my $totnew = 0;
  131. my $totbackedup = 0;
  132. my $totobsolete = 0;
  133.  
  134. my $verbose = 0;
  135. my $quiet = 0;
  136. my ($debug, $trace, $test) = (0, 0, 0);
  137. options ();
  138. $verbose = 0 if $quiet;
  139. $trace |= $debug;
  140. $verbose |= $trace;
  141.  
  142. ################ The Process ################
  143.  
  144. # Append psion name and disk to the directories.
  145. if ( $drive eq 'r' ) {
  146.     $src_dir .= '/rom::';
  147. }
  148. else {
  149.     $src_dir .= '/loc::' . ($drive eq 'i' ? 'm' : $drive) . ':';
  150. }
  151. unless ( -d $src_dir ) {
  152.     print STDERR ("Source directory $src_dir does not exist.\n",
  153.           "Backup aborted.\n");
  154.     exit (1);
  155. }
  156. $backup_dir .= '/' . $name unless $name eq '';
  157. unless ( -d $backup_dir ) {
  158.     print STDERR ("Backup directory $backup_dir does not exist.\n",
  159.           "Create manually before proceeding.\n");
  160.     exit (1);
  161. }
  162.  
  163. $backup_dir .= '/' . $drive;
  164. $archive_dir = $backup_dir . '/@archive';
  165.  
  166. # No archiving for ROM and 3-Link.
  167. $archive = 0 if $drive =~ /^[rc]$/;
  168.  
  169. # Do the backup.
  170. do_backup ($src_dir);
  171.  
  172. if ( $verbose ) {
  173.     print STDERR ("Total: ", $totfiles, 
  174.           $totfiles == 1 ? " file" : " files",
  175.           $totbackedup > 0 ? ", $totbackedup backed up" : "",
  176.           $totnew > 0 ? " ($totnew new)" : "",
  177.           $totobsolete > 0 ? ", $totobsolete obsolete" : "",
  178.           ".\n");
  179. }
  180.  
  181. exit 0;
  182.  
  183. ################ Subroutines ################
  184.  
  185. sub do_backup ($) {
  186.     my ($src) = @_;
  187.     my $f;
  188.  
  189.     print STDERR ("Processing directory $src ... ") if $verbose;
  190.  
  191.     # Read the source directory, build file and directory lists.
  192.     my $dir = new DirHandle ($src);
  193.     unless ( defined $dir ) {
  194.     carp ("Cannot access $src: $!\n");
  195.     return;
  196.     }
  197.  
  198.     my %flist = ();
  199.     my @dlist = ();
  200.     while ( defined ($f = $dir->read) ) {
  201.     next if $f eq '.' or $f eq '..';
  202.     my @st = stat ("$src/$f");
  203.     unless ( defined @st and @st > 0 ) {
  204.         carp ("Cannot stat source $src/$f: $!\n");
  205.         next;
  206.     }
  207.     # Push directories, for files save the stat info.
  208.     if ( -d _ ) {
  209.         push (@dlist, "$src/$f");
  210.     }
  211.     else {
  212.         $flist{"$src/$f"} = [ @st ];
  213.     }
  214.     }
  215.  
  216.     if ( $verbose ) {
  217.     my $nfiles = scalar (keys (%flist));
  218.     my $ndirs = scalar (@dlist);
  219.     print STDERR ($nfiles, $nfiles == 1 ? " file" : " files") 
  220.       if $nfiles;
  221.     print STDERR (", ") if $nfiles and $ndirs;
  222.     print STDERR ($ndirs, " director", $ndirs == 1 ? "y" : "ies")
  223.       if $ndirs;
  224.     print STDERR (".") if $nfiles or $ndirs;
  225.     print STDERR ("\n");
  226.     $totfiles += $nfiles;
  227.     }
  228.  
  229.     print STDERR ("dlist = @dlist\n") if $debug;
  230.     print STDERR ("flist = ", join(" ", sort(keys(%flist))), "\n") if $debug;
  231.  
  232.     # Read the backup directory, same procedure.
  233.     my $dst = backup_name ($src);
  234.     my %bflist = ();
  235.     my %bdlist = ();
  236.     $dir = new DirHandle ($dst);
  237.     if ( defined $dir ) {
  238.     while ( defined ($f = $dir->read) ) {
  239.         next if $f eq '.' or $f eq '..' or $f eq '@archive';
  240.         my @st = stat ("$dst/$f");
  241.         unless ( defined @st and @st > 0 ) {
  242.         carp ("Cannot stat $dst/$f: $!\n");
  243.         next;
  244.         }
  245.         if ( -d _ ) {
  246.         $bdlist{"$dst/$f"} = 1;
  247.         }
  248.         else {
  249.         $bflist{"$dst/$f"} = [ @st ];
  250.         }
  251.     }
  252.     
  253.     print STDERR ("bdlist = ",
  254.               join(" ", sort(keys(%bdlist))), "\n") if $debug;
  255.     print STDERR ("bflist = ", 
  256.               join(" ", sort(keys(%bflist))), "\n") if $debug;
  257.     }
  258.  
  259.     # Process the files from the source.
  260.     foreach $f ( sort (keys (%flist)) ) {
  261.     backup ($f, $flist{$f});
  262.     # If found, delete from the backup list.
  263.     delete $bflist{backup_name($f)};
  264.     }
  265.  
  266.     # Process the directories.
  267.     foreach $f ( sort (@dlist) ) {
  268.     do_backup ($f);
  269.     # If found, delete from the backup list.
  270.     delete $bdlist{backup_name($f)};
  271.     }
  272.  
  273.     # Remove obsolete files from the backup.
  274.     foreach $f ( sort (keys (%bflist)) ) {
  275.     if ( $archive ) {
  276.         archive ($f, $archive_dir . substr ($f, length($backup_dir)));
  277.     }
  278.     else {
  279.         print STDERR ("Removing $f\n") if $verbose;
  280.         sys ("rm", $f);
  281.     }
  282.     $totobsolete++;
  283.     }
  284.  
  285.     # Remove obsolete directories.
  286.     foreach $f ( reverse (sort (keys (%bdlist))) ) {
  287.     print STDERR ("Removing $f\n") if $verbose;
  288.     sys ("rmdir", $f);
  289.     }
  290. }
  291.  
  292. # Build backup name for a file.
  293. sub backup_name ($) {
  294.     $backup_dir . substr($_[0], length($src_dir));
  295. }
  296.  
  297. # Build archive name for a file.
  298. sub archive_name ($) {
  299.     $archive_dir . substr($_[0], length($src_dir));
  300. }
  301.  
  302. # Backup a file, if needed.
  303. sub backup ($$) {
  304.     my ($src,$st) = @_;
  305.     my $dst = backup_name ($src);
  306.  
  307.     print STDERR ("=> try $src\n") if $debug;
  308.  
  309.     my @st = stat ($dst);    # extraneous -- but out of reach...
  310.     my $need = '';
  311.  
  312.     if ( defined @st and @st > 0 ) {
  313.     if ( $st[7] != $st->[7] ) {
  314.         $need = "size differs $st[7] -> $st->[7]";
  315.     }
  316.     if ( $st[9] != $st->[9] ) {
  317.         $need .= "\n   and " if $need;
  318.         $need .= "mtime differs ".localtime($st[9])." -> ".
  319.           localtime($st->[9]);
  320.     }
  321.     }
  322.     else {
  323.     $need = 'new file';
  324.     $totnew++;
  325.     }
  326.     return if $need eq '';
  327.     $totbackedup++;
  328.     print STDERR ("Processing file $src: $need\n") if $trace;
  329.  
  330.     if ( $archive and -f $dst ) {
  331.     archive ($dst, archive_name($src));
  332.     }
  333.     print STDERR ("Backing up $src => $dst\n")
  334.       unless $quiet;
  335.     my $dir = dirname ($dst);
  336.     sys ("mkdir", "-p", $dir) unless -d $dir;
  337.     sys ("cp", $src, $dst);
  338.     utime (time, $st->[9], $dst) or carp ("utime $dst: $!\n");
  339. }
  340.  
  341. # Archive a file, moving up older copies.
  342. # sequence is
  343. #   foo.bar -> @archive/foo.bar
  344. #   @archive/foo.bar -> @archive/@a.002/foo.bar
  345. #   @archive/@a.002/foo.bar -> @archive/@a.003/foo.bar
  346. #   ...etc...
  347. sub archive ($$) {
  348.     my ($src, $dst) = @_;
  349.     print STDERR ("Archiving ", $src, "\n") if $verbose;
  350.     my $dir;
  351.     if ( -f $dst and $limit > 0 ) {
  352.     moveup ($dst, 1);
  353.     }
  354.     $dir = dirname ($dst);
  355.     sys ("mkdir", "-p", $dir) unless -d $dir;
  356.     sys ("mv", $src, $dst);
  357. }
  358.  
  359. # Move /path/@archive/@a.(N)/foo.bar -> /path/@archive/@a.(N+1)/foo.bar
  360. # Input name is /path/@archive/foo.bar.
  361. # N = 1 -> source is /path/@archive/foo.bar.
  362. sub moveup ($$) {
  363.     my ($dst, $i) = @_;
  364.     my ($old, $new);
  365.     $old = $dst;
  366.     $old =~ s:/\@archive/:sprintf("%s\@a.%03d/",$&,$i):e if $i > 1;
  367.     ($new = $dst) =~ s:/\@archive/:sprintf("%s\@a.%03d/",$&,$i+1):e;
  368.     if ( -f $new and $i < $limit ) {
  369.     moveup ($dst, $i+1);
  370.     }
  371.     print STDERR ("Moving up $old\n") if $verbose;
  372.     my $dir = dirname ($new);
  373.     sys ("mkdir", "-p", $dir) unless -d $dir;
  374.     sys ("mv", $old, $new);
  375. }
  376.  
  377. # Adviced system command.
  378. sub sys (@) {
  379.     my (@cmd) = @_;
  380.     print STDERR ("+ @cmd\n") if $trace;
  381.     my $ret = 0;
  382.     $ret = system (@cmd);
  383.     print STDERR ("=> ret = $ret from \"@cmd\"\n") unless $ret == 0;
  384.     exit (255) if $ret == 2 or $ret == 3; # INT and QUIT
  385.     $ret;
  386. }
  387.  
  388. # Command line options.
  389. sub options () {
  390.     my $help = 0;        # handled locally
  391.     my $ident = 0;        # handled locally
  392.  
  393.     # Process options.
  394.     if ( @ARGV > 0 && $ARGV[0] =~ /^[-+]/ ) {
  395.     usage (1)
  396.         unless GetOptions ('ident' => \$ident,
  397.                    'name=s' => \$name,
  398.                    'mount=s' => \$src_dir,
  399.                    'backup=s' => \$backup_dir,
  400.                    'disk=s' => \$drive,
  401.                    'archive!' => \$archive,
  402.                    'limit=i' => $limit,
  403.                    'verbose' => \$verbose,
  404.                    'quiet' => \$quiet,
  405.                    'trace' => \$trace,
  406.                    'help' => \$help,
  407.                    'debug' => \$debug)
  408.           && !$help;
  409.     }
  410.     print STDERR ("This is $my_package [$my_name $my_version]\n")
  411.     if $ident;
  412.  
  413.     $drive = lc ($drive);
  414.     usage (1)
  415.       unless $drive =~ /^[iabcr]$/;
  416. }
  417.  
  418. # Usage.
  419. sub usage ($) {
  420.     my ($xit) = @_;
  421.     print STDERR <<EndOfUsage;
  422. This is $my_package [$my_name $my_version]
  423. Usage: $0 [options] [file ...]
  424.     -mount XXX        NFS mounted Psion dir, e.g. $src_dir
  425.     -backup XXX        destination dir, e.g. $backup_dir
  426.     -name XXX        optional name of this Psion
  427.     -disk M        the Psion disk: 'i' (default), 'a', 'b',
  428.                         'c' (3-Link) or 'r' (ROM)
  429.     -[no]archive    do [not] archive old versions
  430.     -limit NN        limit archive to NN versions
  431.     -help        this message
  432.     -ident        show identification
  433.     -verbose        verbose progress information
  434.     -quiet        no progress information
  435. EndOfUsage
  436.     exit $xit if defined $xit and $xit != 0;
  437. }
  438.