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 readtapeid_raw();
  26
  27 if (!open T,'TAPEID') {
  28     $!==&ENOENT or die $!;
  29 } else {
  30     chomp($oldid= <T>);
  31     close T or die $!;
  32     print "Tape is currently labelled \`$oldid'\n" or die $!;
  33     die "$0: use -f to force relabelling\n" unless $force;
  34 }
  35
  36 open T,'>TAPEID' or die $!;
  37 print T "$newid\n" or die $!;
  38 close T or die $!;
  39
  40 writetapeid($newid);
  41 rewind_raw();
  42
  43 print "Labelled tape \`$newid'\n" or die $!;
  44 exit 0;