#!/usr/sbin/perl # /usr/sbin/perl # - man page links should be local, not to reality.sgi.com # - alphabetize classes in method output # ---------------------------------------------------- # VARIABLES $docroot = "\/performer"; $maindocroot = "\/var\/www\/htdocs"; $absdocroot = "$maindocroot$docroot"; $dbsdir = "$absdocroot\/dbs"; $abssrcdir = "$absdocroot\/src"; $cgiroot = "\/cgi-bin"; $fullcgiroot = "/var/www$cgiroot"; $includedir = "$docroot/include"; # ---------------------------------------------------- &start_page(); &get_args(); if ($TYPE eq "CLASS") { &make_class_page($NAME); } elsif ($TYPE eq "METHOD") { &make_meth_page($NAME); } elsif ($TYPE eq "$TOKEN") { &make_token_page($NAME); } &end_page(); sub start_page { print "Content-type: text/html\n\n"; # Required for HTTP/1.0 compat. print "\n\n"; print "Library Search"; print "\n"; print "\n"; print "
"; } sub end_page { print "
"; print "\n\n"; } sub get_args { #print "

ARGV is \"@ARGV\" \n"; $CGI_ARG=$ARGV[0]; #$LANG = "$ARGV[1]"; # print "

ARGV1 is \"$LANG\"\n"; @ARGLIST = split(/,/, $CGI_ARG); $TYPE = $ARGLIST[0]; $NAME = $ARGLIST[1]; $NAME =~ s/-(\d+)/pack("C", "$1")/eg; if ($ARGLIST[2] eq "A"||"B"||"C") { $LANG = $ARGLIST[2]; } if ($ARGLIST[4] eq "LANG") { $LANG = $ARGLIST[5]; } if ($ARGLIST[2] eq "LANG") { $LANG = $ARGLIST[3]; } # This get classname if present for narrow search. DV if ($ARGLIST[2] eq "CLASS") { $SET_CLASS = 1; } #print "

SET_CLASS is $SET_CLASS\n"; $NEWCLASS = $ARGLIST[3]; $NEWCLASS =~ s/-(\d+)/pack("C", "$1")/eg; #print "

CGI_ARG is \"$CGI_ARG\"\n"; #print "

TYPE is \"$TYPE\"; NAME is \"$NAME\"; NAME2 is \"$NAME2\"\n"; } sub make_class_page { local($NAME) = @_; dbmopen(%CLASS_TBL,"$dbsdir/class.dbm",0444) || die "$!"; dbmopen(%CLSMTH,"$dbsdir/clsmth.dbm",0444) || die "$!"; dbmopen(%CLSALSO,"$dbsdir/clsalso.dbm",0444) || die "$!"; dbmopen(%METH_TBL,"$dbsdir/meth.dbm",0444) || die "$!"; dbmopen(%METH_LANG,"$dbsdir/methlang.dbm",0444) || die "$!"; # print "

LANG is \"$LANG\"\n"; if ($CLASS_TBL{$NAME}) { ($DESC,$LIB) = split(/\|/,$CLASS_TBL{$NAME}); #print "

Class $NAME

\n"; ($LIBARG = $LIB) =~ tr/a-z/A-Z/; $LIBARG .= "_HRCHY"; # print "

\"Parent\"\n"; #print "\"${LIB}\""; #print "

library is ${LIB}

\n"; &selectmanpage(); print "

Description: $DESC\n"; print "

Methods:\n"; $METH_COUNTER = 0; #$METH_KEY = $NAME . "_" . $METH_COUNTER; $METH_KEY = $NAME . $METH_NAME; #print "

methname is $METH_NAME

\n"; while (($key, $value) = each(%METH_LANG)) { ($newclass, $newmeth) = split(/\./,$key); #print "$newclass \= $value

\n"; #print "

methkey is $METH_KEY

\n"; #print "

\n"; } # end while $ALSO_COUNTER = 0; $ALSO_KEY = $NAME . "_" . $ALSO_COUNTER; while ($CLSALSO{$ALSO_KEY}) { if ($ALSO_COUNTER == 0) { print "

See Also: "; } $MAKEPAGE_ARG = &packup($CLSALSO{$ALSO_KEY}); #print "$CLSALSO{$ALSO_KEY}"; print "$CLSALSO{$ALSO_KEY}"; $ALSO_COUNTER++; $ALSO_KEY = $NAME . "_" . $ALSO_COUNTER; if ($CLSALSO{$ALSO_KEY}) { print ", "; } else { print "."; } } } else { print "

 

Sorry, no information available for ${NAME}"; } dbmclose(%METH_LANG); dbmclose(%CLASS_TBL); dbmclose(%CLSMTH); dbmclose(%CLSALSO); dbmclose(%METH_TBL); } # END make_class_page sub print_meth { #$MAKEPAGE_ARG = &packup($CLSMTH{$METH_KEY}); $MAKEPAGE_ARG = &packup($newmeth); # Added to get Class name for narrowed search, DV $NEWNAME = &packup($NAME); #$NEWNAME = &packup($newmeth); #print "

Methname is $METH_NAME\n"; #$newmeth #print "
$CLSMTH{$METH_KEY}\n"; print "
 \; \; \; \; \;$newmeth\n"; } # END print_meth sub make_meth_page { local($NAME) = @_; dbmopen(%METH_TBL,"$dbsdir/meth.dbm",0444) || die "$!"; print "

Method $NAME

\n"; $COUNTER = 0; $NAME_KEY = $NAME . "_" . $COUNTER; while ($METH_TBL{$NAME_KEY}) { ($SYNTAX,$CLASS,$INCLUDE) = split(/\|/,$METH_TBL{$NAME_KEY}); $MAKEPAGE_ARG = &packup($CLASS); # Added to check Class and if present only print where class matches. DV if ($SET_CLASS =~ "1") { if ($CLASS eq $NEWCLASS) { &prtmethod(); } } else { &prtmethod(); } $COUNTER++; $NAME_KEY = $NAME . "_" . $COUNTER; } dbmclose(%METH_TBL); } #END make_meth_page sub prtmethod { print "

Class: $CLASS\n"; #print "

Class: $CLASS\n"; print "

  $SYNTAX\n"; #$INCLUDE =~ s/\/; $inclhead = $1; #$INCLUDE =~ s/\<.*\>/<\$inclhead<\/A>>/; $INCLUDE =~ s/\<.*\>/<\Performer$inclhead<\/A>>/; print "

  $INCLUDE\n"; } sub packup { $ALL = ""; local (@string) = split(//,(pop(@_))); # Split all chars in string foreach $i (@string) { $j = ord($i); # Get the ordinal value of this char $ALL = "$ALL" . "-$j" ; # Concatenate to string ALL w/- sign } return $ALL ; # Give back better than what you got } sub make_token_page { local($NAME) = @_; dbmopen(%TOKEN_TBL,"$dbsdir/token.dbm",0444) || die "$!"; print "

Token $NAME

\n"; $COUNTER = 0; $NAME_KEY = $NAME . "_" . $COUNTER; while (($key, $value) = each(%TOKEN_TBL)) { $key =~ s/(\w)_\d+/$1/; if ($key eq $NAME) { print "$value
\n"; } # end if } # end while } # end make_token_page sub selectmanpage { # Check to see if C and C++ have been selected and for existence of # man page in C or C++ if (-f "$absdocroot/html_mans/${NAME}.html") { print "

Class ${NAME}

\n"; } elsif ($LANG =~ "C") { print "

Class ${NAME}

\n"; } elsif ($LANG =~ "A") { print "

Class ${NAME}

\n"; } elsif (($LANG =~ "B") && (-f "$absdocroot/html_mans/c/${NAME}.html")) { print "

Class ${NAME}

\n"; } } sub selectmanpageold { # Check to see if C and C++ have been selected and for existence of # man page in C or C++ if (-f "$absdocroot/html_mans/${NAME}.html") { print " \"Man\n"; } elsif ($LANG =~ "C") { print " \"Man\n"; } elsif ($LANG =~ "A") { print " \"Man\n"; } elsif (($LANG =~ "B") && (-f "$absdocroot/html_mans/c/${NAME}.html")) { print " \"Man\n"; } }