Listing 1: perl program for building a permutated index

#! /usr/bin/perl

# Build a permutated index of already formatted and installed man pages

#-----------------------------------------------------------------------
# CHANGE THE FOLLOWING TO FIT LOCAL CUSTOM
#-----------------------------------------------------------------------

#
# Specify the page format
#
$Line = 80;                             # Total line length (incl. margins)
$LeftMargen = 5;                        # Size of Left Margin
$RightMargen = 3;                       # Size of Right Margin

#
# Where the formatted man pages are
#
$ManDir{ '/usr/share/man' }++;
$ManDir{ '/usr/share/man/old' }++;
$ManDir{ '/usr/X11/man' }++;
$ManDir{ '/usr/contrib/man' }++;
$ManDir{ '/usr/local/man' }++;
$ManDir{ '/usr/contrib/man' }++;
$ManDir{ '/usr/contrib/mh/man' }++;
$ManDir{ '/usr/contrib/isode/man' }++;

#
# Man Page Chapters Extention
#
@DirExt = ( 1, 2, 3, 4, 5, 6, 7, 8 );

#-----------------------------------------------------------------------
#     END OF CUSTOM CONFIG
#-----------------------------------------------------------------------

#
# Words not keywords in Permutated Index
#
$NoneWord{ '-' }++;
$NoneWord{ 'a' }++;
$NoneWord{ 'an' }++;
$NoneWord{ 'am' }++;
$NoneWord{ 'and' }++;
$NoneWord{ 'are' }++;
$NoneWord{ 'by' }++;
$NoneWord{ 'for' }++;
$NoneWord{ 'get' }++;
$NoneWord{ 'has' }++;
$NoneWord{ 'have' }++;
$NoneWord{ 'in' }++;
$NoneWord{ 'information' }++;
$NoneWord{ 'info' }++;
$NoneWord{ 'is' }++;
$NoneWord{ 'it' }++;
$NoneWord{ 'of' }++;
$NoneWord{ 'on' }++;
$NoneWord{ 'or' }++;
$NoneWord{ 'set' }++;
$NoneWord{ 'the' }++;
$NoneWord{ 'to' }++;
$NoneWord{ 'version' }++;
$NoneWord{ 'via' }++;
$NoneWord{ 'when' }++;
$NoneWord{ 'what' }++;
$NoneWord{ 'which' }++;
$NoneWord{ 'while' }++;
$NoneWord{ 'you' }++;
$NoneWord{ 'your' }++;
$NoneWord{ 'yours' }++;

#
# Make some reasonable size calculation, based on line format

$Name = int(($Line - $LeftMargen - $RightMargen) / 100 * 15);
$Name = 10 if $Name < 10;
$Name = 20 if $Name > 20;
$Size = int(($Line - $Name - 1)/2);

#
# The tmp file we are using
#
open( ERR, ">/tmp/xindex" ) || die "open /tmp/xindex";

#-----------------------------------------------------------------------
#
# Start of main program
#

foreach $Dir ( sort keys %ManDir ) {

Ext: foreach $Ext ( @DirExt ) {
$DirName = "$Dir/cat$Ext";
printf ERR "Now  trying $DirName\n";
unless ( opendir( DIR, $DirName )  ) {
print ERR "cannot open $DirName\n";
next Ext;
}

@Files = readdir DIR;
foreach ( @Files ) {
next if /^\./;
&Get( "$DirName/$_" );
}
close( DIR );
}
}
&Print;

#-----------------------------------------------------------------------
#
# Get the information for permutated index from formatted man page file.
#

package Get;

sub main'Get {

local( $Path ) = @_;

unless( open( FILE, $Path ) ) {
print ERR "cannot open file: $Path\n";
return;
}

$GotIt = 0;
$Count = 0;
$Line = "";
$No = 'noonehome';

while( <FILE> ) {
$Count++;
chop;
print ERR ("$Path: Unformatted source?  Ignored\n"), return if /^\./;
s/.//g;
$No = $1 if /^(\w+\(\w+\))/;
$No =~ tr/A-Z/a-z/;
if ( $GotIt ) {
if ( $Line =~ /\w-$/ ) {
s/^\s+//;
s/\s+$//;
chop( $Line );
$Line = "$Line$_";
}
else {
$Line = ($Line eq '' ) ? $_ : "$Line $_";
}
last if $_ eq '';
}
$GotIt++ if /^name/i;
last if $Count > 15;
}
close( FILE );

last if $No eq 'noonehome';

if ( $Line ne '' ) {
$Line =~ s/--*/-/;
$Line =~ s/\s+-\s+/: /;
@Line2 = split( ' ', $Line );
@Line1 = ();

while( $#Line2 >= 0 ) {
$Line1 = join( ' ', @Line1);
$Line2 = join( ' ', @Line2);
if ( ! defined $main'NoneWord{ $Line2[0] } ) {
$Key = $Line2;
$Key =~ s/^\W+// if $Key =~/^\W+/;
$Key =~ tr/A-Z/a-z/;
$Out = sprintf( "%s|%s|%s|%s",
$Key, $Line2, $Line1, $No );
$main'Out{$Out}++;
}
push( @Line1, shift( @Line2 ));
}
}
else {
if ( $Count == 0 ) {
print ERR "FILE EMPTY FOR $Path\n";
}
else {
print ERR "BAD FORMAT FOR $Path\n";
}
}
}

#-----------------------------------------------------------------------
#
#   Print the permutated index.
#

package Print;

sub main'Print {

foreach( sort keys %main'Out ) {
( $Key, $Line2, $Line1, $No ) = split( '\|', $_);
if ( length( $Line1 ) > $main'Size ) {
$Line1 = substr($Line1, - ($main'Size - 2) );
$Line1 =~ s/^\w+/*/;
}
if ( length( $Line2 ) > $main'Size ) {
$Line2 = substr($Line2, 0, $main'Size - 2 );
$Line2 =~ s/\w+$/*/;
}
if( length( $No ) > $main'Name ) {
$No = substr( $No, 0, $main'Name - 1 );
$No = "${No}*";
}
$Dots = $main'Size - length($Line2);
printf( "%${main'Size}s   %s%s %s\n", $Line1, $Line2, '.' x $Dots,  $No );
}