empire/empserver
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use strict & warnings. Fix several minor bugs uncovered by it.

Browse source 
Semantics of assigning to $[ changed in Perl 5, and its use is `highly
discouraged'.  Programs obviously assumed $[ affects all arrays, but
it doesn't in Perl 5.  If these programs ever worked, then certainly
not with Perl 5.  Remove the assignments and shift indexes
accordingly.
This commit is contained in:
Markus Armbruster 2004-01-28 21:21:48 +00:00
parent dfb337891d
commit 759d3185ad
5 changed files with 76 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

9
info/checklist.pl
View file

@ -11,6 +11,11 @@
# to check which Empire commands need to be documented. # to check which Empire commands need to be documented.
# #
use strict;
use warnings;
my ($com, @list, @obsolete, @Commands);
open(LIST, "<player.list") || die "Can't read player.list\n"; open(LIST, "<player.list") || die "Can't read player.list\n";
while(<LIST>) { while(<LIST>) {
@ -60,10 +65,10 @@ while (<LS>) {
close LS; close LS;
print "In list but not Commands:\n"; print "In list but not Commands:\n";
for $l (@list) { for my $l (@list) {
print " $l\n" unless grep (/^$l$/, @Commands); print " $l\n" unless grep (/^$l$/, @Commands);
} }
print "In Commands but not list:\n"; print "In Commands but not list:\n";
for $c (@Commands) { for my $c (@Commands) {
print " $c\n" unless grep(/^$c$/, @list) || grep(/^$c$/, @obsolete); print " $c\n" unless grep(/^$c$/, @list) || grep(/^$c$/, @obsolete);
} }

46
info/emp2html.pl
View file

@ -1,7 +1,9 @@
#!/usr/local/bin/perl #!/usr/local/bin/perl
use strict;
use warnings;
$[ = 1; # set array base to 1 my (@Fld, $str, @a);
line: while (<>) { line: while (<>) {
chop; # strip record separator chop; # strip record separator
@ -9,17 +11,17 @@ line: while (<>) {
procline: procline:
if (/^\.TH/) { if (/^\.TH/) {
$str=$Fld[3]; $str=$Fld[2];
for ($i=4;$i <= $#Fld; $i++) { for (my $i=3; $i <= $#Fld; $i++) {
$str .= " " . $Fld[$i]; $str .= " " . $Fld[$i];
} }
$str = &htmlify($str); $str = &htmlify($str);
printf("<title>%s : %s</title><h1>%s : %s</h1>\n", printf("<title>%s : %s</title><h1>%s : %s</h1>\n",
$Fld[2],$str,$Fld[2], $str); $Fld[1], $str, $Fld[1], $str);
next line; next line;
} }
if (/^\.SY/) { if (/^\.SY../) {
# $i = $_ =~ "\"" && ($RLENGTH = length($&), $RSTART = length($`)+1); # $i = $_ =~ "\"" && ($RLENGTH = length($&), $RSTART = length($`)+1);
# $str = substr($_, $i + 1, length($_) - $i - 1); # $str = substr($_, $i + 1, length($_) - $i - 1);
$str = substr($_,5); $str = substr($_,5);
@ -28,13 +30,13 @@ procline:
next line; next line;
} }
if (/^\.EX/) { if (/^\.EX../) {
$str = substr($_, 5); $str = substr($_, 5);
printf "<br><samp>[##:##] </samp><kbd>%s</kbd><p>\n", &htmlify($str); printf "<br><samp>[##:##] </samp><kbd>%s</kbd><p>\n", &htmlify($str);
next line; next line;
} }
if (/^\.L/) { if (/^\.L../) {
$str = substr($_, 4); $str = substr($_, 4);
printf "<h2>%s</h2>\n", &htmlify($str); printf "<h2>%s</h2>\n", &htmlify($str);
next line; next line;
@ -48,8 +50,8 @@ procline:
if (/^\.SA/) { if (/^\.SA/) {
@a = split('[: ",.]+'); @a = split('[: ",.]+');
printf("See also : %s\n",&anchor($a[3]) ); printf("See also : %s\n",&anchor($a[2]) );
for ($i = 4; $i <= $#a ; ($i)++) { for (my $i = 3; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
@ -58,7 +60,7 @@ procline:
@a = split('[: ,.]+'); @a = split('[: ,.]+');
@Fld = split(' ', $_, 9999); @Fld = split(' ', $_, 9999);
if (/^\./) { goto procline; } if (/^\./) { goto procline; }
for ($i = 1; $i <= $#a ; ($i)++) { for (my $i = 0; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
} }
@ -71,8 +73,8 @@ procline:
if (/^(See also|See Also|see also)/) { if (/^(See also|See Also|see also)/) {
@a = split('[: ,.]+'); @a = split('[: ,.]+');
printf("See also : %s\n",&anchor($a[3]) ); printf("See also : %s\n",&anchor($a[2]) );
for ($i = 4; $i <= $#a ; ($i)++) { for (my $i = 3; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
@ -81,7 +83,7 @@ procline:
@a = split('[: ,.]+'); @a = split('[: ,.]+');
@Fld = split(' ', $_, 9999); @Fld = split(' ', $_, 9999);
if (/^\./) { goto procline; } if (/^\./) { goto procline; }
for ($i = 1; $i <= $#a ; ($i)++) { for (my $i = 0; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
} }
@ -103,8 +105,8 @@ procline:
#} #}
sub anchor { sub anchor {
local($_) = @_; local ($_) = @_;
local(@file,$file); my (@file,$file);
$file = $_ . ".t"; $file = $_ . ".t";
# if (-r $file) { # if (-r $file) {
if (1) { if (1) {
@ -113,9 +115,9 @@ sub anchor {
} else { } else {
@file = <$_*t>; @file = <$_*t>;
if (@file) { if (@file) {
warn "Expanding $_ to $file[$[]\n"; warn "Expanding $_ to $file[0]\n";
$file[$[] =~ s/.t$/.html/; $file[0] =~ s/.t$/.html/;
return ("<a href=\"$file[$[]\">$_</a>"); return ("<a href=\"$file[0]\">$_</a>");
} else { } else {
warn "Unable to link $_\n"; warn "Unable to link $_\n";
return ( "<em>$_</em>"); return ( "<em>$_</em>");
@ -126,7 +128,7 @@ sub anchor {
# Translate HTML special characters into escape sequences # Translate HTML special characters into escape sequences
sub htmlify { sub htmlify {
local($_) = @_; local ($_) = @_;
s/^\"(.*)\"$/$1/; s/^\"(.*)\"$/$1/;
s/\\&//g; # a nothing character s/\\&//g; # a nothing character
s/\&/&amp;/g; s/\&/&amp;/g;
@ -134,15 +136,15 @@ sub htmlify {
s/\>/&gt;/g; s/\>/&gt;/g;
while (@a = /(\\\*Q)([A-Za-z0-9\-\.]+)(\\\*U)/) { while (@a = /(\\\*Q)([A-Za-z0-9\-\.]+)(\\\*U)/) {
/(\\\*Q)([A-Za-z\-]+)(\\\*U)/; /(\\\*Q)([A-Za-z\-]+)(\\\*U)/;
$_ = $` . &anchor($a[2]) . $'; $_ = $` . &anchor($a[1]) . $';
} }
while (@a = /(\\\*Q)(\"info )([A-Za-z0-9\-\.]+)(\\\*U)/) { while (@a = /(\\\*Q)(\"info )([A-Za-z0-9\-\.]+)(\\\*U)/) {
/(\\\*Q)(\"info )([\w\-\.]+)(\\\*U)/; /(\\\*Q)(\"info )([\w\-\.]+)(\\\*U)/;
$_ = $` . "\"info " . &anchor($a[3]) . $'; $_ = $` . "\"info " . &anchor($a[2]) . $';
} }
while (@a = /(\"info )([A-Za-z0-9\-\.]+)/) { while (@a = /(\"info )([A-Za-z0-9\-\.]+)/) {
/(\"info )([\w\-\.]+)/; /(\"info )([\w\-\.]+)/;
$_ = $` . "\"info " . &anchor($a[2]) . $'; $_ = $` . "\"info " . &anchor($a[1]) . $';
} }
s/\\\*Q/<em>/g; s/\\\*Q/<em>/g;
s/\\\*U/<\/em>/g; s/\\\*U/<\/em>/g;

18
info/info.pl
View file

@ -84,6 +84,12 @@
# flush_subj Print a row of Subjects to TOP # flush_subj Print a row of Subjects to TOP
# error Print an integrity error to STDERR and exit with code 1. # error Print an integrity error to STDERR and exit with code 1.
use strict;
use warnings;
our (@dirs, $dir, $filename, %filedir, @Subjects, $type, %desc, %level);
our (%see_also, %subject, %largest, $subj, @rowsubj, @colsubj, @subj);
eval("require 5"); # Test for perl version 5 eval("require 5"); # Test for perl version 5
die "info.pl requires version 5 of perl.\n" if $@; die "info.pl requires version 5 of perl.\n" if $@;
@ -208,9 +214,9 @@ sub parse_file {
# Create %subject from %see_also # Create %subject from %see_also
sub parse_see_also { sub parse_see_also {
local (@see_also) = split(/, /, $see_also{$filename}); my (@see_also) = split(/, /, $see_also{$filename});
local ($dir) = $filedir{$filename}; local ($dir) = $filedir{$filename};
local ($found); # Does this item belong to any Subject? my ($found); # Does this item belong to any Subject?
for (@see_also) { for (@see_also) {
if (!(defined $filedir{$_})) { # is this entry a subject? if (!(defined $filedir{$_})) { # is this entry a subject?
@ -225,6 +231,7 @@ sub parse_see_also {
# Add a new entry to %subject and possibly to %largest # Add a new entry to %subject and possibly to %largest
sub set_subject { sub set_subject {
$subject{$_}{$dir} .= "$filename\n"; $subject{$_}{$dir} .= "$filename\n";
$largest{$_} = "" unless defined $largest{$_};
$largest{$_} = $filename if length $filename > length $largest{$_}; $largest{$_} = $filename if length $filename > length $largest{$_};
$largest{$_} = $dir if length $dir > length $largest{$_}; $largest{$_} = $dir if length $dir > length $largest{$_};
} }
@ -283,8 +290,9 @@ EOF
$subj eq 'TOP' || grep (/^$subj$/, @rowsubj); $subj eq 'TOP' || grep (/^$subj$/, @rowsubj);
} }
for $i (0..2) { my $k = 0;
for ($j = $i; $j <= $#rowsubj; $j += 3) { for my $i (0..2) {
for (my $j = $i; $j <= $#rowsubj; $j += 3) {
$colsubj[$j] = $rowsubj[$k++]; $colsubj[$j] = $rowsubj[$k++];
} }
} }
@ -316,7 +324,7 @@ sub flush_subj {
# Print an integrity error message and exit with code 1 # Print an integrity error message and exit with code 1
sub error { sub error {
local ($error) = @_; my ($error) = @_;
print STDERR "Error on line $. of $filedir{$filename}/$filename.t:\n"; print STDERR "Error on line $. of $filedir{$filename}/$filename.t:\n";
print STDERR "$_"; print STDERR "$_";

3
info/ls2html.pl
View file

@ -1,5 +1,8 @@
#!/usr/local/bin/perl #!/usr/local/bin/perl
use strict;
use warnings;
printf("<pre>\n"); printf("<pre>\n");
while (<>) { while (<>) {
s/([\w\.\-]+)\.html/<a href=\"$1.html\">$1<\/a>/g; s/([\w\.\-]+)\.html/<a href=\"$1.html\">$1<\/a>/g;

56
info/subj2html.pl
View file

@ -1,8 +1,10 @@
#!/usr/local/bin/perl #!/usr/local/bin/perl
use strict;
use warnings;
$[ = 1; # set array base to 1 my $dome = 0;
$dome = 0; my (@Fld, $str, @a);
line: while (<>) { line: while (<>) {
chop; # strip record separator chop; # strip record separator
@ -10,17 +12,17 @@ line: while (<>) {
procline: procline:
if (/^\.TH/) { if (/^\.TH/) {
$str=$Fld[3]; $str=$Fld[2];
for ($i=4;$i <= $#Fld; $i++) { for (my $i=3; $i <= $#Fld; $i++) {
$str .= " " . $Fld[$i]; $str .= " " . $Fld[$i];
} }
$str = &htmlify($str); $str = &htmlify($str);
printf("<title>%s : %s</title><h1>%s : %s</h1>\n", printf("<title>%s : %s</title><h1>%s : %s</h1>\n",
$Fld[2],$str,$Fld[2], $str); $Fld[1], $str, $Fld[1], $str);
next line; next line;
} }
if (/^\.SY/) { if (/^\.SY../) {
# $i = $_ =~ "\"" && ($RLENGTH = length($&), $RSTART = length($`)+1); # $i = $_ =~ "\"" && ($RLENGTH = length($&), $RSTART = length($`)+1);
# $str = substr($_, $i + 1, length($_) - $i - 1); # $str = substr($_, $i + 1, length($_) - $i - 1);
$str = substr($_,5); $str = substr($_,5);
@ -29,7 +31,7 @@ procline:
next line; next line;
} }
if (/^\.EX/) { if (/^\.EX../) {
$str = substr($_, 5); $str = substr($_, 5);
printf "<br><samp>[##:##] </samp><kbd>%s</kbd><p>\n", &htmlify($str); printf "<br><samp>[##:##] </samp><kbd>%s</kbd><p>\n", &htmlify($str);
next line; next line;
@ -37,8 +39,8 @@ procline:
if (/^\.L/) { if (/^\.L/) {
@a = split('[: ",.]+'); @a = split('[: ",.]+');
$str = &anchor($a[3]); $str = &anchor($a[2]);
$str = ("$str $a[4]"); $str = ("$str $a[3]") if defined $a[3];
printf("<br>%s\n", $str); printf("<br>%s\n", $str);
next line; next line;
} }
@ -53,9 +55,9 @@ procline:
if ($dome == 1) { if ($dome == 1) {
@a = split('[: ",.]+'); @a = split('[: ",.]+');
for ($i = 2; $i <= $#a ; ($i)++) { for (my $i = 1; $i <= $#a ; ($i)++) {
printf("%s",&anchor($a[$i])); printf("%s",&anchor($a[$i]));
for ($j = 0; $j < 20 - length($a[$i]); $j++) { for (my $j = 0; $j < 20 - length($a[$i]); $j++) {
printf(" "); printf(" ");
} }
} }
@ -65,9 +67,9 @@ procline:
@a = split('[: ,.]+'); @a = split('[: ,.]+');
@Fld = split(' ', $_, 9999); @Fld = split(' ', $_, 9999);
if (/^\./) { goto procline; } if (/^\./) { goto procline; }
for ($i = 2; $i <= $#a ; ($i)++) { for (my $i = 1; $i <= $#a ; ($i)++) {
printf("%s",&anchor($a[$i])); printf("%s",&anchor($a[$i]));
for ($j = 0; $j < 20 - length($a[$i]); $j++) { for (my $j = 0; $j < 20 - length($a[$i]); $j++) {
printf(" "); printf(" ");
} }
} }
@ -79,8 +81,8 @@ procline:
if (/^\.SA/) { if (/^\.SA/) {
@a = split('[: ",.]+'); @a = split('[: ",.]+');
printf("See also : %s\n",&anchor($a[3]) ); printf("See also : %s\n",&anchor($a[2]) );
for ($i = 4; $i <= $#a ; ($i)++) { for (my $i = 3; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
@ -89,7 +91,7 @@ procline:
@a = split('[: ,.]+'); @a = split('[: ,.]+');
@Fld = split(' ', $_, 9999); @Fld = split(' ', $_, 9999);
if (/^\./) { goto procline; } if (/^\./) { goto procline; }
for ($i = 1; $i <= $#a ; ($i)++) { for (my $i = 0; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
} }
@ -102,8 +104,8 @@ procline:
if (/^(See also|See Also|see also)/) { if (/^(See also|See Also|see also)/) {
@a = split('[: ,.]+'); @a = split('[: ,.]+');
printf("See also : %s\n",&anchor($a[3]) ); printf("See also : %s\n",&anchor($a[2]) );
for ($i = 4; $i <= $#a ; ($i)++) { for (my $i = 3; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
@ -112,7 +114,7 @@ procline:
@a = split('[: ,.]+'); @a = split('[: ,.]+');
@Fld = split(' ', $_, 9999); @Fld = split(' ', $_, 9999);
if (/^\./) { goto procline; } if (/^\./) { goto procline; }
for ($i = 1; $i <= $#a ; ($i)++) { for (my $i = 0; $i <= $#a ; ($i)++) {
printf(", %s\n",&anchor($a[$i])); printf(", %s\n",&anchor($a[$i]));
} }
} }
@ -134,8 +136,8 @@ procline:
#} #}
sub anchor { sub anchor {
local($_) = @_; local ($_) = @_;
local(@file,$file); my (@file, $file);
$file = $_ . ".t"; $file = $_ . ".t";
# if (-r $file) { # if (-r $file) {
if (1) { if (1) {
@ -144,9 +146,9 @@ sub anchor {
} else { } else {
@file = <$_*t>; @file = <$_*t>;
if (@file) { if (@file) {
warn "Expanding $_ to $file[$[]\n"; warn "Expanding $_ to $file[0]\n";
$file[$[] =~ s/.t$/.html/; $file[0] =~ s/.t$/.html/;
return ("<a href=\"$file[$[]\">$_</a>"); return ("<a href=\"$file[0]\">$_</a>");
} else { } else {
warn "Unable to link $_\n"; warn "Unable to link $_\n";
return ( "<em>$_</em>"); return ( "<em>$_</em>");
@ -165,15 +167,15 @@ sub htmlify {
s/\>/&gt;/g; s/\>/&gt;/g;
while (@a = /(\\\*Q)([A-Za-z0-9\-\.]+)(\\\*U)/) { while (@a = /(\\\*Q)([A-Za-z0-9\-\.]+)(\\\*U)/) {
/(\\\*Q)([A-Za-z\-]+)(\\\*U)/; /(\\\*Q)([A-Za-z\-]+)(\\\*U)/;
$_ = $` . &anchor($a[2]) . $'; $_ = $` . &anchor($a[1]) . $';
} }
while (@a = /(\\\*Q)(\"info )([A-Za-z0-9\-\.]+)(\\\*U)/) { while (@a = /(\\\*Q)(\"info )([A-Za-z0-9\-\.]+)(\\\*U)/) {
/(\\\*Q)(\"info )([\w\-\.]+)(\\\*U)/; /(\\\*Q)(\"info )([\w\-\.]+)(\\\*U)/;
$_ = $` . "\"info " . &anchor($a[3]) . $'; $_ = $` . "\"info " . &anchor($a[2]) . $';
} }
while (@a = /(\"info )([A-Za-z0-9\-\.]+)/) { while (@a = /(\"info )([A-Za-z0-9\-\.]+)/) {
/(\"info )([\w\-\.]+)/; /(\"info )([\w\-\.]+)/;
$_ = $` . "\"info " . &anchor($a[2]) . $'; $_ = $` . "\"info " . &anchor($a[1]) . $';
} }
s/\\\*Q/<em>/g; s/\\\*Q/<em>/g;
s/\\\*U/<\/em>/g; s/\\\*U/<\/em>/g;