rlm@0: #!/usr/bin/perl
rlm@0: 
rlm@0: use strict;
rlm@0: use vars qw / $javadocRoots $indexFile $resultFrame $linkFrame $gzip /;
rlm@0: #####################################################################
rlm@0: #
rlm@0: # javadoc-search
rlm@0: #
rlm@0: # http://sourceforge.net/projects/javadoc-search/
rlm@0: #
rlm@0: # Copyright (C) 2002-2003, Nicholas Sushkin.
rlm@0: #
rlm@0: #     This program is free software; you can redistribute it and/or modify
rlm@0: #     it under the terms of the GNU General Public License as published by
rlm@0: #     the Free Software Foundation; either version 2 of the License, or
rlm@0: #     (at your option) any later version.
rlm@0: #
rlm@0: #     This program is distributed in the hope that it will be useful,
rlm@0: #     but WITHOUT ANY WARRANTY; without even the implied warranty of
rlm@0: #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
rlm@0: #     GNU General Public License for more details.
rlm@0: #
rlm@0: #     You should have received a copy of the GNU General Public License
rlm@0: #     along with this program; if not, write to the Free Software
rlm@0: #     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
rlm@0: # 
rlm@0: #
rlm@0: # Instructions are at http://javadoc-search.sourceforge.net/
rlm@0: #
rlm@0: #
rlm@0: #####################################################################
rlm@0: #
rlm@0: # $Id: javadoc-search.pl,v 1.8 2003/08/19 00:11:09 nsushkin Exp $
rlm@0: #
rlm@0: #####################################################################
rlm@0: 
rlm@0: ### Indexing setup
rlm@0: 
rlm@0: # list of subdirectories of docroot to search for javadoc index files
rlm@0: # Windows and Apache - prefix with drive letter and use only lowercase letters.
rlm@0: #    $javadocRoots = [ "c:/program\ files/apache/htdocs/docs" ];
rlm@0: # Unix 
rlm@0: #    $javadocRoots = [ "/usr/local/apache/htdocs/docs" ];
rlm@0: $javadocRoots = [ "/usr/local/apache/htdocs/docs" ];
rlm@0: 
rlm@0: # index file, if ends with .gz will use gzip
rlm@0: # Windows
rlm@0: #   $indexFile = "c:/bin/apache\ group/apache/javadoc-index.txt";
rlm@0: # Unix
rlm@0: #   $indexFile = "/usr/local/apache/htdocs/docs/javadoc-index.txt.gz";
rlm@0: $indexFile = "/usr/local/apache/htdocs/docs/javadoc-index.txt.gz";
rlm@0: 
rlm@0: ### Display style setup
rlm@0: 
rlm@0: # if $resultFrame is not empty, display search results in this frame
rlm@0: $resultFrame = "";
rlm@0: 
rlm@0: # if $linkFrame is not empty, open javadoc links in this frame
rlm@0: $linkFrame = "";
rlm@0: 
rlm@0: ### Auxillary programs setup
rlm@0: 
rlm@0: # which gzip
rlm@0: $gzip = "/usr/bin/gzip";
rlm@0: 
rlm@0: # nothing below is customizable
rlm@0: #####################################################################
rlm@0: use Getopt::Std;
rlm@0: use File::Find;
rlm@0: 
rlm@0: my @indexFiles;
rlm@0: my %links;
rlm@0: 
rlm@0: (my $rev = '$Revision: 1.8 $') =~ s/^\$\w+: ([\.\d]+) \$$/$1/;
rlm@0: 
rlm@0: sub usage
rlm@0: {
rlm@0:     print STDERR <<EOUSAGE;
rlm@0: Javadoc Search $rev
rlm@0: 
rlm@0: Usage: $0 [-h] [-r]
rlm@0: 
rlm@0:    -h     prints this help
rlm@0:    -r     builds index
rlm@0: 
rlm@0:    This is a cgi script to search javadoc for classes, members, and methods
rlm@0:    using an index.
rlm@0: EOUSAGE
rlm@0:         
rlm@0: }
rlm@0: 
rlm@0: #
rlm@0: # Build index part
rlm@0: #
rlm@0: sub indexWrite
rlm@0: {
rlm@0:     print STDERR "Writing all ", indexGetLinkCount(), " links to $indexFile .. ";
rlm@0: 
rlm@0:     if ($indexFile =~ /\.gz$/)
rlm@0:     {
rlm@0:         open(OUTPUT, "| $gzip -c > \"$indexFile\"") || die "unable to gzip to $indexFile: $!\n";
rlm@0:     } 
rlm@0:     else 
rlm@0:     {
rlm@0:         open(OUTPUT, ">" . $indexFile) || die "unable to write to $indexFile: $!\n";
rlm@0:     }
rlm@0: 
rlm@0:     my $oldSearchKey = "";
rlm@0:     foreach (sort { $links{$a} cmp $links{$b} } keys %links)
rlm@0:     {
rlm@0:         my $searchKey = $links{$_};
rlm@0:         if ($searchKey ne $oldSearchKey) 
rlm@0:         { 
rlm@0:             if ($oldSearchKey ne "") { print OUTPUT "\n"; }
rlm@0:             print OUTPUT $searchKey; 
rlm@0:         }
rlm@0:         print OUTPUT "\t", $_;
rlm@0: 
rlm@0:         $oldSearchKey = $searchKey;
rlm@0:     }
rlm@0:     print OUTPUT "\n";
rlm@0: 
rlm@0:     close(OUTPUT);
rlm@0: 
rlm@0:     print STDERR "done\n";
rlm@0: }
rlm@0: 
rlm@0: sub indexGetLinkCount
rlm@0: {
rlm@0:     scalar(keys %links);
rlm@0: }
rlm@0: 
rlm@0: sub indexRebuild
rlm@0: {
rlm@0:     find(\&indexFileFinder, @$javadocRoots);
rlm@0: 
rlm@0:     foreach (@indexFiles)
rlm@0:     {
rlm@0:         parseLinks($$_[0], $$_[1]);
rlm@0:     }
rlm@0: }
rlm@0: 
rlm@0: sub indexFileFinder
rlm@0: {
rlm@0:     return unless -f $File::Find::name;
rlm@0:     return unless /^index-.*html??/;
rlm@0: 
rlm@0:     push @indexFiles, [$File::Find::name, $File::Find::dir];
rlm@0: }
rlm@0: 
rlm@0: sub indexAddLink
rlm@0: {
rlm@0:     my $key = shift;
rlm@0:     my $link = shift;
rlm@0: 
rlm@0:     $links{$link} = $key;
rlm@0: }
rlm@0: 
rlm@0: sub parseLinks()
rlm@0: {
rlm@0:     my $fileName = shift;
rlm@0:     my $dirName = shift;
rlm@0: 
rlm@0:     print STDERR "Parsing ", $fileName, ": ";
rlm@0: 
rlm@0:     open(FILE, $fileName);
rlm@0: 
rlm@0:     while(<FILE>)
rlm@0:     {
rlm@0:         if($_ =~ m/<A[^>]+?HREF\s*=\s*[\"\']?([^\'\" >]+?)[ \'\"]?(>| title=)/sig)
rlm@0:         {
rlm@0:             parseLink($1, $dirName);
rlm@0:         }
rlm@0:     }
rlm@0: 
rlm@0:     close(FILE);
rlm@0: 
rlm@0:     print STDERR indexGetLinkCount(), " links\n";
rlm@0: }
rlm@0: 
rlm@0: sub parseLink()
rlm@0: {
rlm@0:     my $link = shift;
rlm@0:     my $dirName = shift;
rlm@0: 
rlm@0:     return if $link =~ qr'^(http|ftp)://'i;
rlm@0: 
rlm@0:     # print "# link=", $link, "\n";
rlm@0: 
rlm@0:     my $abslink = ( $link =~ qr'^[\./]*([^\./].*)' ) ? $1 : $link;
rlm@0:     # print "# abslink= $abslink\n";
rlm@0: 
rlm@0:     return unless $abslink =~ qr'/';
rlm@0:     
rlm@0:     my ($file,$anchor) = split '#', $abslink;
rlm@0:     # print "# file=$file, anchor=$anchor\n";
rlm@0: 
rlm@0:     my $class = ($file =~ /(.*)\.html??/ ) ? $1 : return;
rlm@0:     $class =~ tr{\/}{\.};
rlm@0: 
rlm@0:     # print "# class=", $class, "\n";
rlm@0:     # print "# dirname=", $dirName, "\n";
rlm@0: 
rlm@0:     # cancel out ".."
rlm@0:     if ($link =~ /^\.\.\//)
rlm@0:     {
rlm@0:         my @linkSegs = split '/', $link;
rlm@0:         my @dirSegs = split '/', $dirName;
rlm@0: 
rlm@0:         while (@linkSegs[0] eq '..' and $#dirSegs >= 0)
rlm@0:         {
rlm@0:             shift @linkSegs;
rlm@0:             pop @dirSegs;
rlm@0:         }
rlm@0:         $link = join '/', @linkSegs;
rlm@0:         $dirName = join '/', @dirSegs;
rlm@0:     }
rlm@0:     my $fullLink = ( $link =~ /^\// ) ? $link : $dirName . "/" . $link;
rlm@0: 
rlm@0:     my $key = $anchor eq "" ? $class : $class . '#' . $anchor;
rlm@0:     indexAddLink($key, $fullLink);
rlm@0: }
rlm@0: 
rlm@0: #
rlm@0: # CGI part
rlm@0: #
rlm@0: use CGI qw(:standard);
rlm@0: 
rlm@0: my $searchTypes = {'c'=>'class','cm'=>'class#member','cma'=>'class#member(args)'};
rlm@0: 
rlm@0: sub topFrameGenerate
rlm@0: {
rlm@0:     Delete('render');
rlm@0:     param('render', 'query');
rlm@0:     my $queryFrameUrl = self_url;
rlm@0: 
rlm@0:     Delete('render');
rlm@0:     param('render', 'noResults');
rlm@0:     my $noResultsFrameUrl = self_url;
rlm@0: 
rlm@0:     return
rlm@0:         header(),
rlm@0:         html(head(title('Javadoc search')),
rlm@0:              frameset({-rows => '150,*'},
rlm@0:                       frame({-name => 'query', -src => $queryFrameUrl}),
rlm@0:                       frame({-name => $resultFrame, -src => $noResultsFrameUrl})));
rlm@0: }
rlm@0: 
rlm@0: sub noResultsGenerate
rlm@0: {
rlm@0:     return
rlm@0:         header,
rlm@0:         start_html('Javadoc search'),
rlm@0:         h2('No results yet'),
rlm@0:         end_html,
rlm@0:         "\n";
rlm@0: }
rlm@0: 
rlm@0: sub searchFormGenerate
rlm@0: {
rlm@0:     Delete('render');
rlm@0: 
rlm@0:     return
rlm@0:         h1('Javadoc search'),
rlm@0:         $resultFrame ? start_form(-target => $resultFrame, -action=>script_name) : start_form(-action=>script_name),
rlm@0:         "Search pattern ", 
rlm@0:         textfield(-name=>'pattern', -size=>15),
rlm@0:         " in ",
rlm@0:         scrolling_list(-name=>'type',
rlm@0:                        -values=>[sort(keys(%$searchTypes))],
rlm@0:                        -labels=>$searchTypes,
rlm@0:                        -defaults=>['c'],
rlm@0:                        -size=>1),
rlm@0:         " and display ",
rlm@0:         scrolling_list(-name=>'results',
rlm@0:                        -values=>['1', '10', '20', '50', '0'],
rlm@0:                        -labels=>{'1'=>'1', '10'=>'10', '20'=>'20', '50'=>'50', '0'=>'All'},
rlm@0:                        -defaults=>['10'],
rlm@0:                        -size=>1),
rlm@0:         " results ",
rlm@0:         submit(-name=>'go', -value=>'Go'), submit(-name=>'lucky', -value=>'Go!'),
rlm@0:         $resultFrame ? hidden(-name => 'render', -default => 'results') : "",
rlm@0:         end_form,
rlm@0:         $resultFrame ? "" : hr;
rlm@0: }
rlm@0: 
rlm@0: sub doSearch
rlm@0: {
rlm@0:     my ($pattern, $type, $results) = @_;
rlm@0: 
rlm@0:     if (! -r $indexFile)
rlm@0:     {
rlm@0:         print strong("Error: index file is not readable");
rlm@0:         return;
rlm@0:     }
rlm@0: 
rlm@0:     if ($indexFile =~ /\.gz$/)
rlm@0:     {
rlm@0:         open(INPUT, "$gzip -dc \"$indexFile\" |") || die "unable to un-gzip $indexFile: $!\n";
rlm@0:     } 
rlm@0:     else 
rlm@0:     {
rlm@0:         open(INPUT, $indexFile) || die "unable to read $indexFile: $!\n";
rlm@0:     }
rlm@0:     
rlm@0:     my $docRoot = $ENV{'DOCUMENT_ROOT'};
rlm@0:     my @matches;
rlm@0: 
rlm@0:   INPUTLINE: 
rlm@0:     while(<INPUT>)
rlm@0:     {
rlm@0:         chomp;
rlm@0:         my ($key, @urls) = split (/\t/);
rlm@0:         
rlm@0:         for ($key)
rlm@0:         {
rlm@0:             if (($type eq "c" and /\#/) ||
rlm@0:                 ($type eq "cm" and !(/\#/ and !/\)/)) ||
rlm@0:                 ($type eq "cma" and !(/\#/ and /\)/)))
rlm@0:             {
rlm@0:                 next INPUTLINE;
rlm@0:             }
rlm@0:         }
rlm@0: 
rlm@0:         if ($key =~ /$pattern/ and ($results == 0 or $#matches < $results) )
rlm@0:         {
rlm@0:             push @matches, [ ( $key, map { s/$docRoot//; $_ } @urls ) ];
rlm@0:         }
rlm@0: 
rlm@0:         last if $results > 0 and $#matches >= $results;
rlm@0: 
rlm@0:     }
rlm@0:     close(INPUT);
rlm@0: 
rlm@0:     return \@matches;
rlm@0: }
rlm@0: 
rlm@0: sub displayLuckyMatch
rlm@0: {
rlm@0:     my $matches = shift;
rlm@0: 
rlm@0:     if ( $#$matches < 0 )
rlm@0:     {
rlm@0:         print 
rlm@0:             header,
rlm@0:             start_html('No matches'),
rlm@0:             p("No matches"),
rlm@0:             end_html;
rlm@0:     }
rlm@0:     else
rlm@0:     {
rlm@0:         print
rlm@0:             $linkFrame ? header(-target => $linkFrame) : "",
rlm@0:             redirect('-location'=> $$matches[0][1]);
rlm@0:     }
rlm@0: }
rlm@0: 
rlm@0: 
rlm@0: sub displayMatches
rlm@0: {
rlm@0:     my $matches = shift;
rlm@0: 
rlm@0:     if ( $#$matches < 0 )
rlm@0:     {
rlm@0:         print p("No matches");
rlm@0:     }
rlm@0:     else
rlm@0:     {
rlm@0:         print 
rlm@0:             p(
rlm@0:               "Searching pattern ", em(escapeHTML(param('pattern'))),
rlm@0:               " in ", em(escapeHTML($$searchTypes{param('type')}))),
rlm@0:             h2("Search results"),
rlm@0:             "<ul>";
rlm@0:         
rlm@0:         foreach my $match (@$matches)
rlm@0:         {
rlm@0:             my $searchKey = escapeHTML(shift @$match);
rlm@0:             my $cnt = -1;
rlm@0:             print li( map {  
rlm@0:                 a( $linkFrame ? {-href => $_, -target => $linkFrame } : { -href => $_}, ( $cnt++ >= 0 ? "alt".($cnt) : $searchKey) ) 
rlm@0:                 } @$match );
rlm@0:             
rlm@0:         }
rlm@0:         
rlm@0:         print "</ul>";
rlm@0:     }
rlm@0: }
rlm@0: 
rlm@0: #
rlm@0: # main
rlm@0: #
rlm@0: use vars qw / $opt_h $opt_r /;
rlm@0: 
rlm@0: if (server_software() eq 'cmdline')
rlm@0: {
rlm@0:     getopts("rh");
rlm@0: 
rlm@0:     if ($opt_h)
rlm@0:     {
rlm@0:         usage;
rlm@0:         exit;
rlm@0:     }
rlm@0:     
rlm@0:     if ($opt_r)
rlm@0:     {
rlm@0:         indexRebuild;
rlm@0:         indexWrite;
rlm@0:         exit;
rlm@0:     }
rlm@0: }
rlm@0: 
rlm@0: 
rlm@0: if (param('render'))
rlm@0: {
rlm@0:     $resultFrame = 'results';
rlm@0:     $linkFrame = '';
rlm@0: }
rlm@0: 
rlm@0: my $thisFrame = param('render');
rlm@0: 
rlm@0: if ($thisFrame eq 'topFrame')
rlm@0: {
rlm@0:     print topFrameGenerate();
rlm@0:     exit 0;
rlm@0: }
rlm@0: elsif ($thisFrame eq 'noResults')
rlm@0: {
rlm@0:     print noResultsGenerate();
rlm@0:     exit 0;
rlm@0: }
rlm@0: 
rlm@0: unless (param('lucky') and param('pattern'))
rlm@0: {
rlm@0:     print 
rlm@0:         header,
rlm@0:         start_html('Javadoc search'),
rlm@0:         defined(param('pattern')) && $resultFrame ? "" : searchFormGenerate();
rlm@0: }
rlm@0: 
rlm@0: if (param('pattern')) 
rlm@0: {
rlm@0:     my $matches = doSearch(param('pattern'), param('type'), param('results'));
rlm@0: 
rlm@0:     if (param('lucky'))
rlm@0:     {
rlm@0:         displayLuckyMatch($matches);
rlm@0:     }
rlm@0:     else
rlm@0:     {
rlm@0:         displayMatches($matches);
rlm@0:     }
rlm@0: }
rlm@0: else
rlm@0: {
rlm@0:     if ($thisFrame ne 'query')
rlm@0:     {
rlm@0:         print p('Specify non-blank search pattern');
rlm@0:     }
rlm@0: }
rlm@0: 
rlm@0: unless (param('lucky') and param('pattern'))
rlm@0: {
rlm@0:     print end_html;
rlm@0: }