/usr/share/pennmush/game/txt/index-files.pl is in pennmush-common 1.8.2p8-1ubuntu3.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | #!/usr/bin/perl
#
# index-files.pl - make an & index topic for events/news/help
#
# Called by compose-tricky
#
# Take a MUSH help.txt format file on the stdin, and write a
# "& entries" entry or entries.
# Lines with entries to be indexed start with &'s.
# Write the resulting entries to the stdout, also in help.txt format,
# in columns and paged.
# Idea by Schmidt@Dune, perl version by Alan Schwartz (Javelin/Paul)
# with mods by Jeff Heinen. Modified further by Raevnos.
#
# Usage: index-files.pl [options] < news.txt > nws/index.nws
#
require 5; # Sorry, Talek.
use strict;
use Getopt::Long;
use locale;
my (@entries, @aentries);
# Have we got any options?
my($first,$longest) = ("","");
exit 1 unless GetOptions ('first' => \$first, 'longest' => \$longest);
# Collect all the topic names
my @set = ();
my @aset = ();
while (<STDIN>) {
chomp;
next if /^& &?Entries/o; # Skip index entries.
if ((@set or @aset) and $_ !~ /&\s+\S/) {
# We've got a set of entries now. Choose which to add.
if ($first) {
# Add the first one
push(@entries,$set[0]) if $set[0];
push(@aentries,$aset[0]) if $aset[0];
}
if ($longest) {
# Add the longest one
@set = sort { length($b) <=> length($a) } @set;
@aset = sort { length($b) <=> length($a) } @aset;
push(@entries,$set[0]) if $set[0];
push(@aentries,$aset[0]) if $aset[0];
}
if (!$first and !$longest) {
# Add all
push(@entries,@set) if @set;
push(@aentries,@aset) if @aset;
}
@set = (); @aset = ();
}
push @aset,$1 if /^&\s+(&.*)/o; # Catch admin-help entries
push @set, $1 if /^&\s+([^&].*)/o; # Catch normal entries.
}
# If anything's left in @set/@aset now, someone's screwed up
# Make 'em all lower-case and sort 'em.
@entries = map { lc $_ } @entries;
@aentries = map { lc $_ } @aentries;
sub withnumchecking;
my @sorted = ($#entries > 0) ? (sort withnumchecking @entries) : @entries;
my @asorted = ($#entries > 0) ? (sort withnumchecking @aentries) : @aentries;
my $maxlines = 14;
my $maxlen = 25;
my $separator ="-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-\n";
my $three_items = " %-25.25s %-25.25s %-25.25s\n"; # Format for three entries
my $bigone = " %-51.51s %-25.25s\n"; # Format for two entries, long first.
my $bigtwo = " %-25.25s %-51.51s\n"; # Format for two entries, long second.
my $admin = 0;
my $index;
foreach $index (\@sorted, \@asorted) {
my $i = 0;
my $title = $admin ? "&Entries" : "Entries";
$admin++;
my $titlecount = 1;
my $header = 0;
my ($entry1, $entry2, $entry3);
print "\n& $title\n", $separator;
while (@$index) {
if (${$index}[0] eq "help") {
shift @$index;
next;
}
if ($header) {
print "& $title-$titlecount\n", $separator;
$header = 0;
}
$entry1 = shift @$index;
$entry2 = shift @$index;
$entry2 = "" if !defined $entry2;
if (length($entry1) > $maxlen) {
if (length($entry2) > $maxlen) {
printf " %-76.76s\n", $entry1;
unshift @$index, $entry2;
} else {
printf $bigone, $entry1, $entry2;
}
} else {
if (length($entry2) > $maxlen) {
printf $bigtwo, $entry1, $entry2;
} else {
$entry3 = shift @$index;
$entry3 = "" if !defined $entry3;
if (length($entry3) > $maxlen) {
unshift @$index, $entry3;
$entry3 ="";
}
printf $three_items, $entry1, $entry2, $entry3;
}
}
if ($i++ > $maxlines) {
$titlecount++;
print "\nFor more, see $title-$titlecount\n", $separator;
$header = 1;
$i = 0;
}
}
}
print $separator;
sub withnumchecking {
my($firsta, $firstb) = ($a,$b);
my($lasta, $lastb);
($firsta, $lasta) = ($1,$2) if $a =~ /(.+)p(\d+)/o;
($firstb, $lastb) = ($1,$2) if $b =~ /(.+)p(\d+)/o;
my $res = $firsta cmp $firstb;
return $res if $res;
if (!defined($lasta)) {
warn "Possible duplicate help topic: $a\n";
return $res;
}
return $lasta <=> $lastb;
}
|