365 lines
9.4 KiB
Perl
Executable File
365 lines
9.4 KiB
Perl
Executable File
#!/usr/sbin/perl
|
|
|
|
# Notes:
|
|
#
|
|
# - going to have a problem with casing
|
|
# - handle metachars
|
|
|
|
# ----------------------------------------------------
|
|
# VARIABLES
|
|
|
|
$docroot = "\/performer";
|
|
$maindocroot = "\/var\/www\/htdocs";
|
|
$absdocroot = "$maindocroot$docroot";
|
|
$dbsdir = "$absdocroot\/dbs";
|
|
$abssrcdir = "$absdocroot\/src";
|
|
|
|
$cgiroot = "\/cgi-bin";
|
|
$fullcgiroot = "/var/www$cgiroot";
|
|
|
|
# ----------------------------------------------------
|
|
|
|
# Main
|
|
|
|
&read_in_args();
|
|
|
|
if ($TYPE ne "SAMPLE") {
|
|
&do_search($TYPE,$STRING);
|
|
} elsif ($TYPE eq "SAMPLE") {
|
|
$PRINTED_TYPE = "Sample";
|
|
&which_lang();
|
|
&start_page();
|
|
#&searchsamples($TYPE,$STRING,$PRINTED_TYPE,$LANG);
|
|
&searchsamples();
|
|
&printnine();
|
|
&end_page();
|
|
exit;
|
|
}
|
|
|
|
if ($TYPE eq "CLASS") {
|
|
$PRINTED_TYPE = "Class";
|
|
} elsif ($TYPE eq "TOKEN") {
|
|
$PRINTED_TYPE = "Token";
|
|
} else {
|
|
$PRINTED_TYPE = "Method";
|
|
}
|
|
|
|
if ($RESULT_LENGTH == 0) {
|
|
&start_page();
|
|
print "<P>Search for $PRINTED_TYPE <B>$PASSED_IN_STRING</B> ";
|
|
print "returned 0 results.\n";
|
|
&end_page();
|
|
} elsif ($RESULT_LENGTH == 1) {
|
|
&which_lang();
|
|
#&start_page();
|
|
# problem here 10-28-97
|
|
# Sends args to pfmakepage.cgi. The page is created from there
|
|
print `$fullcgiroot/pfmakepage.cgi ${TYPE},@MATCHLIST,$LANG`;
|
|
} else {
|
|
# if more than one hit print options
|
|
&start_page();
|
|
print "<P>Search for <B>$PASSED_IN_STRING</B> in <EM>$PRINTED_TYPE</EM> table ";
|
|
if ($PRINTED_TYPE =~ /Token/) {
|
|
print "resulted in the following $TKNRESULT_LENGTH hit(s):<P>\n";
|
|
} else {
|
|
print "resulted in the following $RESULT_LENGTH hit(s):<P>\n";
|
|
}
|
|
&which_lang();
|
|
&print_results();
|
|
&end_page();
|
|
}
|
|
|
|
|
|
|
|
# Subs
|
|
|
|
sub read_in_args {
|
|
|
|
# Get the input coming from the FORM as standard input:
|
|
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
|
|
|
|
# Split the name-value pairs
|
|
@PAIRS = split(/&/, $buffer);
|
|
|
|
foreach $PAIR (@PAIRS) {
|
|
#print "<P>Pair is $PAIR\n";
|
|
($NAME, $VALUE) = split(/=/, $PAIR);
|
|
#print "<P>NAME is $NAME, and VALUE is $VALUE\n";
|
|
if ($NAME =~ /RESET/) {
|
|
print "Location:$cgiroot/pfsearch.cgi\n\n";
|
|
#print "<A HREF=\"$cgiroot/pfsearch.cgi\" TARGET=\"search_frame\">there</A>";
|
|
exit;
|
|
}
|
|
if ($NAME =~ /STRING/) {
|
|
#print "<P>Preparsed \$STRING is $VALUE\n";
|
|
# This is for reporting back to the user
|
|
$PASSED_IN_STRING = $VALUE;
|
|
$PASSED_IN_STRING =~ s/\%3F/\?/g;
|
|
$PASSED_IN_STRING =~ s/\%5C/\\/g;
|
|
$PASSED_IN_STRING =~ s/\%2B/\+/g;
|
|
$PASSED_IN_STRING =~ s/\%3D/\=/g;
|
|
$PASSED_IN_STRING =~ s/\%24/$/g;
|
|
$PASSED_IN_STRING =~ s/\%5E/^/g;
|
|
#$PASSED_IN_STRING =~ y/A-Z/a-z/;
|
|
$STRING = $VALUE;
|
|
# wildcard support (a UNIX/Perl Hybrid; escape wildcards for literals)
|
|
#$STRING =~ s/\*/\*/g;
|
|
$STRING =~ s/\%3F/\?/g;
|
|
$STRING =~ s/\%2B/\+/g;
|
|
$STRING =~ s/\%5C/\\/g;
|
|
$STRING =~ s/\%3D/\\=/g;
|
|
$STRING =~ s/\%24/$/g;
|
|
$STRING =~ s/\%5E/^/g;
|
|
$STRING =~ y/A-Z/a-z/;
|
|
#print "<P>\$STRING is \"$STRING\"";
|
|
next;
|
|
}
|
|
if ($NAME =~ /TYPE/) {
|
|
$TYPE = $VALUE;
|
|
next;
|
|
}
|
|
if ($NAME =~ /CNOT/) {
|
|
$CNOT = "A";
|
|
#next;
|
|
}
|
|
if ($NAME =~ /LANGCPLUS/) {
|
|
$LANGCPLUS = "C";
|
|
#next;
|
|
}
|
|
|
|
}
|
|
|
|
} # end read_in_args
|
|
|
|
sub start_page {
|
|
|
|
print "Content-type: text/html\n\n"; # Required for HTTP/1.0 compat.
|
|
print "<HTML><HEAD><TITLE>Search Results</TITLE></HEAD>\n";
|
|
print "<BODY BGCOLOR=\"f2f5bd\">\n";
|
|
if ($PRINTED_TYPE eq "Sample") {
|
|
print "<TABLE><TR><TD WIDTH=\"30\"></TD><TD COLSPAN=3>";
|
|
} else {
|
|
print "<TABLE><TR><TD WIDTH=\"30\"></TD><TD WIDTH=\"500\">";
|
|
}
|
|
print "<H2>Search Results</H2>\n";
|
|
|
|
}
|
|
|
|
sub end_page {
|
|
|
|
print "</TD></TR></TABLE>";
|
|
print "</BODY>\n";
|
|
print "</HTML>\n";
|
|
|
|
}
|
|
|
|
|
|
sub do_search {
|
|
|
|
local($TYPE,$STRING) = @_;
|
|
|
|
$RESULT_LENGTH = 0;
|
|
|
|
if ($TYPE eq "CLASS") { $TBL = "$dbsdir/class.dbm"; }
|
|
elsif ($TYPE eq "TOKEN") { $TBL = "$dbsdir/tokens.dbm"; }
|
|
elsif ($TYPE eq "METHOD") { $TBL = "$dbsdir/meth.dbm"; }
|
|
|
|
dbmopen(%TABLE,"$TBL",0444) || die "$!";
|
|
$KEY = "";
|
|
while (($KEY, $FOO) = each(%TABLE)) {
|
|
|
|
if (($TYPE eq "METHOD") && !($KEY =~ s/_0$//)) {
|
|
next;
|
|
}
|
|
|
|
if ($TYPE eq "TOKEN") {
|
|
$KEY =~ s/(.*)_\d*$/$1/;
|
|
}
|
|
|
|
($L_KEY = $KEY) =~ y/A-Z/a-z/;
|
|
|
|
if ($L_KEY =~ /$STRING/) {
|
|
|
|
if ($TYPE eq "TOKEN") {
|
|
push(@MATCHLIST,"$FOO");
|
|
#$TOKENRESULT_LENGTH++;
|
|
} else {
|
|
push(@MATCHLIST,"$KEY");
|
|
}
|
|
|
|
$RESULT_LENGTH++;
|
|
|
|
} # end if
|
|
|
|
|
|
} # end while
|
|
@TOKENLIST = grep(!$seen{$_}++, @MATCHLIST);
|
|
$TKNRESULT_LENGTH = @TOKENLIST;
|
|
|
|
dbmclose(%TABLE);
|
|
|
|
} # end do_search
|
|
|
|
|
|
sub which_lang {
|
|
SWITCH: {
|
|
if (($CNOT eq "A") && ($LANGCPLUS eq "C")) { $LANG = "B"; last SWITCH; }
|
|
if (($CNOT eq "A") && ($LANGCPLUS ne "C")) { $LANG = "A"; last SWITCH; }
|
|
if (($CNOT ne "A") && ($LANGCPLUS eq "C")) { $LANG = "C"; last SWITCH; }
|
|
if (($CNOT ne "A") && ($LANGCPLUS ne "C")) { $LANG = "B"; last SWITCH; }
|
|
}
|
|
|
|
|
|
}
|
|
|
|
sub print_results {
|
|
|
|
if ($TYPE =~ /TOKEN/) {
|
|
#print "<P>TEST\n";
|
|
#print "<P>Match list is @TOKENLIST\n";
|
|
foreach $MATCH (sort(@TOKENLIST)) {
|
|
$NAME = $MATCH;
|
|
&selectmanpage($NAME);
|
|
}
|
|
} else {
|
|
|
|
foreach $MATCH (sort(@MATCHLIST)) {
|
|
|
|
#print "<P>Match is $MATCH\n";
|
|
$MAKEPAGE_ARG = &PACK($MATCH);
|
|
|
|
print " <A HREF=\"$cgiroot/pfmakepage.cgi?${TYPE},${MAKEPAGE_ARG},$LANG\">$MATCH</A><BR>\n";
|
|
#print "<A HREF=\"$cgiroot/pfmakepage.cgi?${TYPE},${MAKEPAGE_ARG}?{PRINTED_TYPE},${PASSED_IN_STRING}\">$MATCH</A><BR>\n";
|
|
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
|
|
sub PACK {
|
|
|
|
$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 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 " \; \; \; \; \;<A HREF=\"$docroot/html_mans/${NAME}.html\">${NAME}</A><BR>\n";
|
|
} elsif ($LANG =~ "C") {
|
|
print " \; \; \; \; \;<A HREF=\"$docroot/html_mans/C/${NAME}.html\">${NAME}</A><BR>\n";
|
|
} elsif ($LANG =~ "A") {
|
|
print " \; \; \; \; \;<A HREF=\"$docroot/html_mans/c/${NAME}.html\">${NAME}</A><BR>\n";
|
|
} elsif (($LANG =~ "B") && (-f "$absdocroot/html_mans/c/${NAME}.html")) {
|
|
print " \; \; \; \; \;<A HREF=\"$docroot/html_mans/B/${NAME}.html\">${NAME}</A><BR>\n";
|
|
}
|
|
|
|
}
|
|
|
|
# ---------------------------------------------------------------
|
|
sub searchsamples {
|
|
|
|
#local($TYPE,$STRING,$PRINTED_TYPE,$LANG) = @_;
|
|
$RESULT_LENGTH = 0;
|
|
|
|
opendir(SRC_DIR,"$abssrcdir");
|
|
#print "Lang is $LANG\n";
|
|
#print "3 $abssrcdir\n";
|
|
foreach $ENTRY (grep(!/^\./, readdir(SRC_DIR))) {
|
|
#print "1 $srcdir\/$ENTRY\n";
|
|
if (-d "$abssrcdir/$ENTRY") {
|
|
#print "\n2 $srcdir/$ENTRY\n";
|
|
&examinedirs("$abssrcdir/$ENTRY");
|
|
}
|
|
|
|
} # end foreach
|
|
|
|
} # end searchsamples
|
|
|
|
sub printnine {
|
|
local($dirpath);
|
|
if (! keys(%hitfiles)) {
|
|
print "Search for <B>$STRING</B> in <EM>Samples</EM> returned 0 results.\n";
|
|
} else {
|
|
print "Search for <B>$STRING</B> in <EM>Samples</EM> resulted in the following " . keys(%hitfiles) . " file(s):<P></TD></TR>\n";
|
|
|
|
print "<TR><TD></TD><TD> <B>File name</B></TD><TD><B>Directory Name</B></TD><TD><B>Hit(s) per file</B></TD>\n";
|
|
foreach $key (sort byhits (keys(%hitfiles))) {
|
|
($name = $key) =~ s/.*\/(.*)$/$1/;
|
|
($dirpath = $key) =~ s/\/performer\/(.*)\/.*$/\/usr\/share\/Performer\/$1/;
|
|
#print "<P>$key has $hitfiles{$key} hits.\n";
|
|
#print "<P>$name has $hitfiles{$key} hits.\n";
|
|
|
|
|
|
print "<TR><TD></TD><TD> <A HREF=\"$cgiroot/pfdispaly.cgi?$key\">$name</A></TD><TD>$dirpath</TD><TD ALIGN=\"CENTER\">$hitfiles{$key}</TD></TR>\n";
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
sub byhits {
|
|
$hitfiles{$b} <=> $hitfiles{$a};
|
|
}
|
|
|
|
sub examinedirs {
|
|
local($DIR) = @_ ;
|
|
local($EMPTY) = "Y";
|
|
local(@FILES) = ();
|
|
|
|
opendir(DIR,"$DIR");
|
|
|
|
rewinddir(DIR);
|
|
foreach $DIR_ENTRY (grep(!/^\./, readdir(DIR))) {
|
|
# print "4 $DIR/$DIR_ENTRY\n";
|
|
if (-d "$DIR/$DIR_ENTRY") {
|
|
#print "\n5 $DIR/$DIR_ENTRY\n";
|
|
&examinedirs("$DIR/$DIR_ENTRY");
|
|
} elsif ((-f "$DIR/$DIR_ENTRY") && ($DIR_ENTRY =~ /\.c$/ || $DIR_ENTRY =~ /\.C$/ || $DIR_ENTRY =~ /\.h$/)) {
|
|
&searchfile("$DIR/$DIR_ENTRY");
|
|
|
|
}
|
|
}
|
|
|
|
} # end examinedirs
|
|
|
|
|
|
# ------
|
|
|
|
sub searchfile {
|
|
local($SRCFILE) = @_ ;
|
|
$RESULT_LENGTH = 0;
|
|
# print "6 $SRCFILE Lang is $LANG, result length is $RESULT_LENGTH\n ";
|
|
$RESULT_COUNTER = 0;
|
|
open(SAMFILE,"$SRCFILE");
|
|
foreach $LIST (<SAMFILE>) {
|
|
$LIST =~ tr/A-Z/a-z/;
|
|
#$srchstring =~ tr/A-Z/a-z/;
|
|
$STRING =~ tr/A-Z/a-z/;
|
|
if ($LIST =~ /$STRING/) {
|
|
$RESULT_COUNTER++;
|
|
#if ($RESULT_COUNTER == 1) {
|
|
# need an assoc array with name of file and number hits
|
|
#$filename = $SRCFILE;
|
|
# print "8 $filename\n";
|
|
|
|
$SRCFILE =~ s/$maindocroot(.*)/$1/;
|
|
$hitfiles{$SRCFILE} = $RESULT_COUNTER;
|
|
#}
|
|
#print "7 $SRCFILE Lang is $LANG, result length is $RESULT_COUNTER\n";
|
|
}
|
|
}
|
|
close(SAMFILE);
|
|
#&printnine();
|
|
} # end searchfile
|
|
|