runtime/khelpcenter/searchhandlers/khc_htsearch.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4
   5 use Encode;
   6 use Getopt::Long;
   7
   8 use open IO => ':utf8';
   9 use open ':std';
  10
  11 my $htsearchpath="/srv/www/cgi-bin/htsearch";
  12
  13 my $config;
  14 my $format;
  15 my $method;
  16 my $words;
  17 my $lang;
  18 my $docbook;
  19 my $indexdir;
  20 my $maxnum;
  21
  22 GetOptions (
  23   'config=s' => \$config,
  24   'format=s' => \$format,
  25   'method=s' => \$method,
  26   'words=s' => \$words,
  27   'lang=s' => \$lang,
  28   'docbook' => \$docbook,
  29   'indexdir=s' => \$indexdir,
  30   'maxnum=s' => \$maxnum
  31 );
  32
  33 if ( !$indexdir ) {
  34   print STDERR "No index dir given.\n";
  35   exit 1;
  36 }
  37
  38 if ( !$lang ) { $lang = "en"; }
  39
  40 my $charset = langCharset( $lang );
  41
  42 $words = encode( $charset, $words );
  43
  44 if ( !open( HTSEARCH, "-|", "$htsearchpath", "-c", "$indexdir/$config.conf",
  45             "format=$format&method=$method&words=$words" ) )
  46 {
  47   print "Can't execute htsearch at '$htsearchpath'.\n";
  48   exit 1;
  49 }
  50
  51 my ($body,$liststart,$ref,$link,$error,$errorOut);
  52
  53 while( <HTSEARCH> ) {
  54   if ( !$body ) {
  55     print;
  56     if ( /^<body/ ) { $body = 1; }
  57   }
  58   if ( /^<h3>/ ) {
  59     print;
  60     print "<ul>\n";
  61     $liststart = 1;
  62   }
  63   if ( /^<img src.*<a href="(.*)">(.*)<\/a>/ ) {
  64     $ref = $1;
  65     $link = $2;
  66
  67     print STDERR "REF: $ref  LINK: $link\n";
  68
  69     $ref =~ s/file:\/\/localhost//;
  70
  71     $ref =~ s/http:\/\/localhost\//file:\//;
  72
  73     if ( $docbook ) {
  74       $ref =~ /help:\/\/(.*)\/index.docbook/;
  75       my $app = $1;
  76       $ref = "help:$app";
  77
  78       $link =~ s/apptitle/$app/;
  79     }
  80
  81     print "  <li><a href=\"$ref\">$link</a></li>\n";
  82   }
  83   if ( /^<h1>ht:\/\/Dig error/ ) {
  84     $error = 1;
  85     print "Htdig error:\n";
  86   }
  87   if ( $error && /^<pre>/ ) {
  88     $errorOut = 1;
  89   }
  90   if ( $errorOut ) {
  91     print;
  92     if ( /^<\/pre>/ ) { $errorOut = 0; }
  93   }
  94 }
  95
  96 close HTSEARCH;
  97
  98 if ( $liststart ) { print "</ul>\n"; }
  99
 100 print "</body></html>\n";
 101
 102 if ( $? != 0 ) { exit $?; }
 103
 104 1;
 105
 106 # Return charset used for given language
 107 sub langCharset( $ )
 108 {
 109   my $lang = shift;
 110   if ( $lang eq "cz" || $lang eq "hu" ) {
 111     return "latin2";
 112   } elsif ( $lang eq "kr" ) {
 113     return "utf8";
 114   } else {
 115     return "latin1";
 116   }
 117 }