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 );
	}

}


