win/macosx/recover.pl

   1 #!/usr/bin/perl
   2
   3 # aNetHack 0.0.1  recover.pl $ANH-Date$  $ANH-Branch$:$ANH-Revision$
   4 # Copyright (c) Kenneth Lorber, Kensington, Maryland, 2009
   5 # aNetHack may be freely redistributed.  See license for details.
   6
   7 # Wrapper for 3.4.3 recover to be called from Applescript to reset the Qt
   8 # package after it locks up due to a bug in suspend handling.
   9
  10 # find the right place
  11 ($playground = $0) =~ s!/recover.pl$!!;
  12 if(! -d $playground){
  13         print "Cannot find playground $playground.";
  14         exit 0
  15 }
  16 if(! -f "$playground/castle.lev" && ! -f "$playground/anhdat"){
  17         print "Failed to find playground $playground.";
  18         exit 0
  19 }
  20 print "Playground is $playground.\n";
  21 chdir $playground or do {
  22         print "Can't get to playground.\n";
  23         exit 0
  24 };
  25 if(-e 'perm_lock'){
  26         print "Attempting to remove perm_lock.\n";
  27         $try_perm = 1;
  28         unlink 'perm_lock';
  29 } else {
  30         print "Did not find perm_lock (this is OK).\n";
  31 }
  32 if(-e 'perm_lock'){
  33         print "Failed to remove perm_lock: $!\n";
  34         exit 0
  35 }
  36 if($try_perm){
  37         print "Removed perm_lock.\n";
  38 }
  39
  40 # run recover, but only if there is something that looks promising
  41 $recover = "./recover";
  42 $recover = "/usr/local/bin/recover" unless(-e $recover);
  43
  44 $uid = $<;
  45 foreach ( <$uid*.0> ){
  46         system ("$recover -d . $_");
  47 }
  48
  49 print "Done.\n";
  50
  51 exit 0