win/share/renumtiles.pl

   1 #!/bin/perl
   2 #
   3 #  $ANH-Date$  $ANH-Branch$:$ANH-Revision$
   4 #
   5
   6 sub bail($);
   7
   8 use Getopt::Std;
   9
  10 # TODO: switch to Getopt::Long so we can parse normal arguments too
  11 $Getopt::Std::STANDARD_HELP_VERSION = TRUE;
  12 $main::VERSION = 1.0;
  13
  14 my %commands = (
  15     'd' => 'debug mode; parse objects.txt to stdout instead of updating',
  16 );
  17
  18 getopts(join('', keys(%commands)));
  19
  20 my $debug = (defined($opt_d) && $opt_d == 1);
  21 my $tilecount = 0;
  22 my $outfile = $debug ? "-" : "objects.txt";
  23 my $infile = $debug ? "objects.txt" : "objects.bak";
  24
  25
  26 unless ($debug) {
  27     if (-e "$infile") { die "something didn't clean up objects.bak from last time; stopping\n"; }
  28     rename($outfile,$infile) or die "couldn't move objects.txt to objects.bak; stopping\n";
  29 }
  30
  31 open(INFILE, "<$infile") or bail("couldn't open $infile; bailing");
  32 open(OUTFILE, ">$outfile") or bail("couldn't open $outfile; bailing");
  33
  34 while (my $line = <INFILE>)
  35 {
  36     if (my ($tiletext) = $line =~ /^# tile \d+ (.*)/)
  37     {
  38         $line = "# tile $tilecount $tiletext\n";
  39         $tilecount++;
  40     }
  41
  42     print OUTFILE $line;
  43 }
  44
  45 close(INFILE);
  46 close(OUTFILE);
  47
  48 unless ($debug) { unlink $infile; }
  49
  50 exit;
  51
  52 sub main::HELP_MESSAGE()
  53 {
  54     print <<"STARTHELP";
  55 Usage: renumtiles.pl [OPTIONS] <textfile>
  56
  57 STARTHELP
  58     foreach $cmd (keys(%commands)) {
  59         printf("%10s          %s\n", '-'.$cmd, $commands{$cmd});
  60     }
  61     print <<"ENDHELP";
  62
  63 \t--help      display this help message and exit
  64 \t--version   display version and exit
  65 ENDHELP
  66     exit;
  67 }
  68
  69 sub main::VERSION_MESSAGE()
  70 {
  71     my ($objglob, $optpackage, $ver, $switches) = @_;
  72     print <<"STARTHELP";
  73 renumtiles $ver -- tile-renumbering utility for aNetHack
  74 STARTHELP
  75 }
  76
  77 sub bail($)
  78 {
  79     unless ($debug) {
  80         unlink $outfile;
  81         rename ($infile,$outfile);
  82     }
  83     shift;
  84     die "$_\n";
  85 }
  86