Mercurial > rlmcintyre

     1 #!/usr/bin/perl

     2 

     3 use strict;

     4 use vars qw / $javadocRoots $indexFile $resultFrame $linkFrame $gzip /;

     5 #####################################################################

     6 #

     7 # javadoc-search

     8 #

     9 # http://sourceforge.net/projects/javadoc-search/

    10 #

    11 # Copyright (C) 2002-2003, Nicholas Sushkin.

    12 #

    13 #     This program is free software; you can redistribute it and/or modify

    14 #     it under the terms of the GNU General Public License as published by

    15 #     the Free Software Foundation; either version 2 of the License, or

    16 #     (at your option) any later version.

    17 #

    18 #     This program is distributed in the hope that it will be useful,

    19 #     but WITHOUT ANY WARRANTY; without even the implied warranty of

    20 #     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    21 #     GNU General Public License for more details.

    22 #

    23 #     You should have received a copy of the GNU General Public License

    24 #     along with this program; if not, write to the Free Software

    25 #     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

    26 # 

    27 #

    28 # Instructions are at http://javadoc-search.sourceforge.net/

    29 #

    30 #

    31 #####################################################################

    32 #

    33 # $Id: javadoc-search.pl,v 1.8 2003/08/19 00:11:09 nsushkin Exp $

    34 #

    35 #####################################################################

    36 

    37 ### Indexing setup

    38 

    39 # list of subdirectories of docroot to search for javadoc index files

    40 # Windows and Apache - prefix with drive letter and use only lowercase letters.

    41 #    $javadocRoots = [ "c:/program\ files/apache/htdocs/docs" ];

    42 # Unix 

    43 #    $javadocRoots = [ "/usr/local/apache/htdocs/docs" ];

    44 $javadocRoots = [ "/usr/local/apache/htdocs/docs" ];

    45 

    46 # index file, if ends with .gz will use gzip

    47 # Windows

    48 #   $indexFile = "c:/bin/apache\ group/apache/javadoc-index.txt";

    49 # Unix

    50 #   $indexFile = "/usr/local/apache/htdocs/docs/javadoc-index.txt.gz";

    51 $indexFile = "/usr/local/apache/htdocs/docs/javadoc-index.txt.gz";

    52 

    53 ### Display style setup

    54 

    55 # if $resultFrame is not empty, display search results in this frame

    56 $resultFrame = "";

    57 

    58 # if $linkFrame is not empty, open javadoc links in this frame

    59 $linkFrame = "";

    60 

    61 ### Auxillary programs setup

    62 

    63 # which gzip

    64 $gzip = "/usr/bin/gzip";

    65 

    66 # nothing below is customizable

    67 #####################################################################

    68 use Getopt::Std;

    69 use File::Find;

    70 

    71 my @indexFiles;

    72 my %links;

    73 

    74 (my $rev = '$Revision: 1.8 $') =~ s/^\$\w+: ([\.\d]+) \$$/$1/;

    75 

    76 sub usage

    77 {

    78     print STDERR <<EOUSAGE;

    79 Javadoc Search $rev

    80 

    81 Usage: $0 [-h] [-r]

    82 

    83    -h     prints this help

    84    -r     builds index

    85 

    86    This is a cgi script to search javadoc for classes, members, and methods

    87    using an index.

    88 EOUSAGE

    89         

    90 }

    91 

    92 #

    93 # Build index part

    94 #

    95 sub indexWrite

    96 {

    97     print STDERR "Writing all ", indexGetLinkCount(), " links to $indexFile .. ";

    98 

    99     if ($indexFile =~ /\.gz$/)

   100     {

   101         open(OUTPUT, "| $gzip -c > \"$indexFile\"") || die "unable to gzip to $indexFile: $!\n";

   102     } 

   103     else 

   104     {

   105         open(OUTPUT, ">" . $indexFile) || die "unable to write to $indexFile: $!\n";

   106     }

   107 

   108     my $oldSearchKey = "";

   109     foreach (sort { $links{$a} cmp $links{$b} } keys %links)

   110     {

   111         my $searchKey = $links{$_};

   112         if ($searchKey ne $oldSearchKey) 

   113         { 

   114             if ($oldSearchKey ne "") { print OUTPUT "\n"; }

   115             print OUTPUT $searchKey; 

   116         }

   117         print OUTPUT "\t", $_;

   118 

   119         $oldSearchKey = $searchKey;

   120     }

   121     print OUTPUT "\n";

   122 

   123     close(OUTPUT);

   124 

   125     print STDERR "done\n";

   126 }

   127 

   128 sub indexGetLinkCount

   129 {

   130     scalar(keys %links);

   131 }

   132 

   133 sub indexRebuild

   134 {

   135     find(\&indexFileFinder, @$javadocRoots);

   136 

   137     foreach (@indexFiles)

   138     {

   139         parseLinks($$_[0], $$_[1]);

   140     }

   141 }

   142 

   143 sub indexFileFinder

   144 {

   145     return unless -f $File::Find::name;

   146     return unless /^index-.*html??/;

   147 

   148     push @indexFiles, [$File::Find::name, $File::Find::dir];

   149 }

   150 

   151 sub indexAddLink

   152 {

   153     my $key = shift;

   154     my $link = shift;

   155 

   156     $links{$link} = $key;

   157 }

   158 

   159 sub parseLinks()

   160 {

   161     my $fileName = shift;

   162     my $dirName = shift;

   163 

   164     print STDERR "Parsing ", $fileName, ": ";

   165 

   166     open(FILE, $fileName);

   167 

   168     while(<FILE>)

   169     {

   170         if($_ =~ m/<A[^>]+?HREF\s*=\s*[\"\']?([^\'\" >]+?)[ \'\"]?(>| title=)/sig)

   171         {

   172             parseLink($1, $dirName);

   173         }

   174     }

   175 

   176     close(FILE);

   177 

   178     print STDERR indexGetLinkCount(), " links\n";

   179 }

   180 

   181 sub parseLink()

   182 {

   183     my $link = shift;

   184     my $dirName = shift;

   185 

   186     return if $link =~ qr'^(http|ftp)://'i;

   187 

   188     # print "# link=", $link, "\n";

   189 

   190     my $abslink = ( $link =~ qr'^[\./]*([^\./].*)' ) ? $1 : $link;

   191     # print "# abslink= $abslink\n";

   192 

   193     return unless $abslink =~ qr'/';

   194     

   195     my ($file,$anchor) = split '#', $abslink;

   196     # print "# file=$file, anchor=$anchor\n";

   197 

   198     my $class = ($file =~ /(.*)\.html??/ ) ? $1 : return;

   199     $class =~ tr{\/}{\.};

   200 

   201     # print "# class=", $class, "\n";

   202     # print "# dirname=", $dirName, "\n";

   203 

   204     # cancel out ".."

   205     if ($link =~ /^\.\.\//)

   206     {

   207         my @linkSegs = split '/', $link;

   208         my @dirSegs = split '/', $dirName;

   209 

   210         while (@linkSegs[0] eq '..' and $#dirSegs >= 0)

   211         {

   212             shift @linkSegs;

   213             pop @dirSegs;

   214         }

   215         $link = join '/', @linkSegs;

   216         $dirName = join '/', @dirSegs;

   217     }

   218     my $fullLink = ( $link =~ /^\// ) ? $link : $dirName . "/" . $link;

   219 

   220     my $key = $anchor eq "" ? $class : $class . '#' . $anchor;

   221     indexAddLink($key, $fullLink);

   222 }

   223 

   224 #

   225 # CGI part

   226 #

   227 use CGI qw(:standard);

   228 

   229 my $searchTypes = {'c'=>'class','cm'=>'class#member','cma'=>'class#member(args)'};

   230 

   231 sub topFrameGenerate

   232 {

   233     Delete('render');

   234     param('render', 'query');

   235     my $queryFrameUrl = self_url;

   236 

   237     Delete('render');

   238     param('render', 'noResults');

   239     my $noResultsFrameUrl = self_url;

   240 

   241     return

   242         header(),

   243         html(head(title('Javadoc search')),

   244              frameset({-rows => '150,*'},

   245                       frame({-name => 'query', -src => $queryFrameUrl}),

   246                       frame({-name => $resultFrame, -src => $noResultsFrameUrl})));

   247 }

   248 

   249 sub noResultsGenerate

   250 {

   251     return

   252         header,

   253         start_html('Javadoc search'),

   254         h2('No results yet'),

   255         end_html,

   256         "\n";

   257 }

   258 

   259 sub searchFormGenerate

   260 {

   261     Delete('render');

   262 

   263     return

   264         h1('Javadoc search'),

   265         $resultFrame ? start_form(-target => $resultFrame, -action=>script_name) : start_form(-action=>script_name),

   266         "Search pattern ", 

   267         textfield(-name=>'pattern', -size=>15),

   268         " in ",

   269         scrolling_list(-name=>'type',

   270                        -values=>[sort(keys(%$searchTypes))],

   271                        -labels=>$searchTypes,

   272                        -defaults=>['c'],

   273                        -size=>1),

   274         " and display ",

   275         scrolling_list(-name=>'results',

   276                        -values=>['1', '10', '20', '50', '0'],

   277                        -labels=>{'1'=>'1', '10'=>'10', '20'=>'20', '50'=>'50', '0'=>'All'},

   278                        -defaults=>['10'],

   279                        -size=>1),

   280         " results ",

   281         submit(-name=>'go', -value=>'Go'), submit(-name=>'lucky', -value=>'Go!'),

   282         $resultFrame ? hidden(-name => 'render', -default => 'results') : "",

   283         end_form,

   284         $resultFrame ? "" : hr;

   285 }

   286 

   287 sub doSearch

   288 {

   289     my ($pattern, $type, $results) = @_;

   290 

   291     if (! -r $indexFile)

   292     {

   293         print strong("Error: index file is not readable");

   294         return;

   295     }

   296 

   297     if ($indexFile =~ /\.gz$/)

   298     {

   299         open(INPUT, "$gzip -dc \"$indexFile\" |") || die "unable to un-gzip $indexFile: $!\n";

   300     } 

   301     else 

   302     {

   303         open(INPUT, $indexFile) || die "unable to read $indexFile: $!\n";

   304     }

   305     

   306     my $docRoot = $ENV{'DOCUMENT_ROOT'};

   307     my @matches;

   308 

   309   INPUTLINE: 

   310     while(<INPUT>)

   311     {

   312         chomp;

   313         my ($key, @urls) = split (/\t/);

   314         

   315         for ($key)

   316         {

   317             if (($type eq "c" and /\#/) ||

   318                 ($type eq "cm" and !(/\#/ and !/\)/)) ||

   319                 ($type eq "cma" and !(/\#/ and /\)/)))

   320             {

   321                 next INPUTLINE;

   322             }

   323         }

   324 

   325         if ($key =~ /$pattern/ and ($results == 0 or $#matches < $results) )

   326         {

   327             push @matches, [ ( $key, map { s/$docRoot//; $_ } @urls ) ];

   328         }

   329 

   330         last if $results > 0 and $#matches >= $results;

   331 

   332     }

   333     close(INPUT);

   334 

   335     return \@matches;

   336 }

   337 

   338 sub displayLuckyMatch

   339 {

   340     my $matches = shift;

   341 

   342     if ( $#$matches < 0 )

   343     {

   344         print 

   345             header,

   346             start_html('No matches'),

   347             p("No matches"),

   348             end_html;

   349     }

   350     else

   351     {

   352         print

   353             $linkFrame ? header(-target => $linkFrame) : "",

   354             redirect('-location'=> $$matches[0][1]);

   355     }

   356 }

   357 

   358 

   359 sub displayMatches

   360 {

   361     my $matches = shift;

   362 

   363     if ( $#$matches < 0 )

   364     {

   365         print p("No matches");

   366     }

   367     else

   368     {

   369         print 

   370             p(

   371               "Searching pattern ", em(escapeHTML(param('pattern'))),

   372               " in ", em(escapeHTML($$searchTypes{param('type')}))),

   373             h2("Search results"),

   374             "<ul>";

   375         

   376         foreach my $match (@$matches)

   377         {

   378             my $searchKey = escapeHTML(shift @$match);

   379             my $cnt = -1;

   380             print li( map {  

   381                 a( $linkFrame ? {-href => $_, -target => $linkFrame } : { -href => $_}, ( $cnt++ >= 0 ? "alt".($cnt) : $searchKey) ) 

   382                 } @$match );

   383             

   384         }

   385         

   386         print "</ul>";

   387     }

   388 }

   389 

   390 #

   391 # main

   392 #

   393 use vars qw / $opt_h $opt_r /;

   394 

   395 if (server_software() eq 'cmdline')

   396 {

   397     getopts("rh");

   398 

   399     if ($opt_h)

   400     {

   401         usage;

   402         exit;

   403     }

   404     

   405     if ($opt_r)

   406     {

   407         indexRebuild;

   408         indexWrite;

   409         exit;

   410     }

   411 }

   412 

   413 

   414 if (param('render'))

   415 {

   416     $resultFrame = 'results';

   417     $linkFrame = '';

   418 }

   419 

   420 my $thisFrame = param('render');

   421 

   422 if ($thisFrame eq 'topFrame')

   423 {

   424     print topFrameGenerate();

   425     exit 0;

   426 }

   427 elsif ($thisFrame eq 'noResults')

   428 {

   429     print noResultsGenerate();

   430     exit 0;

   431 }

   432 

   433 unless (param('lucky') and param('pattern'))

   434 {

   435     print 

   436         header,

   437         start_html('Javadoc search'),

   438         defined(param('pattern')) && $resultFrame ? "" : searchFormGenerate();

   439 }

   440 

   441 if (param('pattern')) 

   442 {

   443     my $matches = doSearch(param('pattern'), param('type'), param('results'));

   444 

   445     if (param('lucky'))

   446     {

   447         displayLuckyMatch($matches);

   448     }

   449     else

   450     {

   451         displayMatches($matches);

   452     }

   453 }

   454 else

   455 {

   456     if ($thisFrame ne 'query')

   457     {

   458         print p('Specify non-blank search pattern');

   459     }

   460 }

   461 

   462 unless (param('lucky') and param('pattern'))

   463 {

   464     print end_html;

   465 }
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 27 Sep 2010 16:57:26 -0400
parents
children