backup/labeltape

   1 #!/usr/bin/perl
   2
   3 use POSIX;
   4
   5 $etc= '/etc/chiark-backup';
   6 require "$etc/settings.pl";
   7 require 'backuplib.pl';
   8
   9 while ($ARGV[0] =~ m/^-/) {
  10     $_= shift @ARGV;
  11     last if m/^\-$/;
  12     s/^\-//;
  13     while (length) {
  14         if (s/^f//) {
  15             $force=1;
  16         } else {
  17             die "$0: unknown option -$_\n";
  18         }
  19     }
  20 }
  21
  22 @ARGV==1 or die "$0: need 1 arg, new TAPEID\n";
  23 ($newid)= @ARGV;
  24
  25 open LOG, ">/dev/null" or die $!;
  26
  27 readtapeid_raw();
  28
  29 if (!open T,'TAPEID') {
  30     $!==&ENOENT or die $!;
  31 } else {
  32     chomp($oldid= <T>);
  33     close T or die $!;
  34     print "Tape is currently labelled \`$oldid'\n" or die $!;
  35     die "$0: use -f to force relabelling\n" unless $force;
  36 }
  37
  38 open T,'>TAPEID' or die $!;
  39 print T "$newid\n" or die $!;
  40 close T or die $!;
  41
  42 writetapeid($newid,'tapeid set manually');
  43 rewind_raw();
  44
  45 print "Labelled tape \`$newid'\n" or die $!;
  46 exit 0;