info-ref

   1 #!/usr/bin/perl
   2 # Copyright (C) 2005  Alex Schroeder <alex@emacswiki.org>
   3 #
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2 of the License, or
   7 # (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program; if not, write to the
  16 #    Free Software Foundation, Inc.
  17 #    59 Temple Place, Suite 330
  18 #    Boston, MA 02111-1307 USA
  19
  20 use strict;
  21 use warnings;
  22 use CGI;
  23 use LWP::UserAgent;
  24 use XML::LibXML;
  25 use URI;
  26
  27 my @indexes = qw(
  28   http://www.gnu.org/software/emacs/manual/html_node/Command-Index.html
  29   http://www.gnu.org/software/emacs/manual/html_node/Variable-Index.html
  30   http://www.gnu.org/software/emacs/manual/html_node/Concept-Index.html
  31   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_728.html
  32   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_729.html
  33   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_730.html
  34   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_731.html
  35   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_732.html
  36   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_733.html
  37   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_734.html
  38   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_735.html
  39   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_736.html
  40   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_737.html
  41   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_738.html
  42   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_739.html
  43   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_740.html
  44   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_741.html
  45   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_742.html
  46   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_743.html
  47   http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_744.html
  48 );
  49
  50 my $db = '/org/org.emacswiki/htdocs/emacs/info-ref.dat';
  51
  52 my $nl = "\n";
  53 my $fs = "\023";
  54 my $gs = "\024";
  55 my $rs = "\025";
  56
  57 my $q = new CGI;
  58 ProcessRequest();
  59
  60 sub ProcessRequest {
  61   if ($q->param('init')) {
  62     Initialize();
  63   } elsif ($q->param('find')) {
  64     Find($q->param('find'));
  65   } else {
  66     ShowForm();
  67   }
  68 }
  69
  70 sub ShowForm {
  71   print $q->header, $q->start_html,
  72     $q->start_form, "Index entry: ", $q->textfield('find'), $q->submit, $q->end_form,
  73     $q->p('$Id: info-ref,v 1.6 2005/08/31 14:01:17 as Exp $'),
  74     $q->end_html;
  75 }
  76
  77 sub Find {
  78   my $str = shift;
  79   my %map = ();
  80   my $data = ReadFileOrDie($db);
  81   foreach my $line (split(/$nl/, $data)) {
  82     my ($key, $rest) = split(/$fs/, $line);
  83     $map{$key} = ();
  84     foreach my $a (split(/$gs/, $rest)) {
  85       my ($link, $label) = split(/$rs/, $a);
  86       $map{$key}{$link} = $label;
  87     }
  88   }
  89   my @links = keys %{$map{$str}};
  90   if ($#links < 0) {
  91     ReportError("No matches found for '$str'", '404 Not Found');
  92   } elsif ($#links == 0) {
  93     print $q->redirect($links[0]);
  94   } else {
  95     my @list = map { $q->a({-href=>$_}, $map{$str}{$_}) } @links;
  96     print $q->header, $q->h1($str), $q->ol($q->li(\@list));
  97   }
  98 }
  99
 100 sub Initialize {
 101   my %map = ();
 102   print $q->header, $q->start_html;
 103   foreach my $url (@indexes) {
 104     print $q->p($url);;
 105     # determine base URI
 106     my $base = URI->new($url);
 107     # fetch and parse data
 108     my $data = GetRaw($url);
 109     # some markup fixes for the elisp manual
 110     $data =~ s/&([<"])/&amp;$1/g;
 111     $data =~ s/<([<"])/&lt;$1/g;
 112     $data =~ s/="fn_"">/="fn_&quot;">/;
 113     $data =~ s/<!DOCTYPE.*?>//;
 114     $data =~ s'</?font.*?>''gi;
 115     $data =~ s'</table><br></P>'</table><br>';
 116     my $parser = XML::LibXML->new();
 117     my $doc;
 118     eval { $doc = $parser->parse_html_string($data); };
 119     print $q->p($@) if $@;
 120     next if $@;
 121     # emacs manual
 122     my @nodelist = $doc->findnodes('/html/body/ul/li');
 123     foreach my $node (@nodelist) {
 124       my $text = $node->textContent;
 125       my ($key) = split(/: /, $text);
 126       my $a = $node->findnodes('descendant::a')->[0];
 127       my $label = $a->textContent;
 128       my $link = $a->getAttribute('href');
 129       my $l = URI->new_abs($link, $base);
 130       # print "$key -> $label $l\n";
 131       $map{$key} = () unless $map{$key};
 132       $map{$key}{$l->canonical} = $label;
 133     }
 134     # elisp manual
 135     @nodelist = $doc->findnodes('descendant::table[position()=3]/descendant::tr');
 136     foreach my $node (@nodelist) {
 137       my ($item, $section) = $node->findnodes('td/a');
 138       next unless $item and $section;
 139       my $key = $item->textContent;
 140       my $label = $section->textContent;
 141       my $link = $item->getAttribute('href');
 142       my $l = URI->new_abs($link, $base);
 143       # print "$key -> $label $l\n";
 144       $map{$key} = () unless $map{$key};
 145       $map{$key}{$l->canonical} = $label;
 146     }
 147   }
 148   my $data = join($nl, map {
 149     my $key = $_;
 150     $key . $fs . join($gs, map {
 151       my $link = $_;
 152       join($rs, $link, $map{$key}{$link});
 153     } keys %{$map{$_}})
 154   } keys %map);
 155   WriteStringToFile($db, $data);
 156   print $q->p('Database initialized'), $q->end_html;
 157 }
 158
 159 sub GetRaw {
 160   my $uri = shift;
 161   return unless eval { require LWP::UserAgent; };
 162   my $ua = LWP::UserAgent->new;
 163   my $response = $ua->get($uri);
 164   return $response->content;
 165 }
 166
 167 sub ReadFile {
 168   my ($filename) = @_;
 169   my ($data);
 170   local $/ = undef;   # Read complete files
 171   if (open(IN, "<$filename")) {
 172     $data=<IN>;
 173     close IN;
 174     return (1, $data);
 175   }
 176   return (0, '');
 177 }
 178
 179 sub ReadFileOrDie {
 180   my ($filename) = @_;
 181   my ($status, $data);
 182   ($status, $data) = ReadFile($filename);
 183   if (!$status) {
 184     ReportError("Cannot open $filename: $!", '500 Internal Server Error');
 185   }
 186   return $data;
 187 }
 188
 189 sub WriteStringToFile {
 190   my ($file, $string) = @_;
 191   open(OUT, ">$file")
 192     or ReportError("Cannot write $file: $!", '500 Internal Server Error');
 193   print OUT  $string;
 194   close(OUT);
 195 }
 196
 197 sub ReportError { # fatal!
 198   my ($errmsg, $status, $log) = @_;
 199   print $q->header(-status => $status);
 200   print $q->start_html, $q->h2($errmsg), $q->end_html;
 201   exit (1);
 202 }