~ubuntu-branches/ubuntu/saucy/dhelp/saucy-proposed

« back to all changes in this revision

Viewing changes to tmp/dhelp-ruby/debian/dhelp/usr/lib/cgi-bin/dsearch

  • Committer: Bazaar Package Importer
  • Author(s): Colin Watson
  • Date: 2008-06-19 01:25:07 UTC
  • Revision ID: james.westby@ubuntu.com-20080619012507-adt75omul1shucde
Tags: 0.6.9ubuntu1
* Resynchronise with Debian. Remaining changes:
  - Recommends: firefox-3.0.
  - Exit zero if the bdb module is not available; this usually indicates
    that dhelp is not configured yet.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#! /usr/bin/perl -T
2
 
#
3
 
# Copyright 2001,2004 by Stefan Hornburg (Racke) <racke@linuxia.de>
4
 
#
5
 
# This program is free software; you can redistribute it and/or modify
6
 
# it under the terms of the GNU General Public License as published by
7
 
# the Free Software Foundation; either version 2 of the License, or
8
 
# (at your option) any later version.
9
 
#
10
 
# This program is distributed in the hope that it will be useful,
11
 
# but WITHOUT ANY WARRANTY; without even the implied warranty of
12
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
 
# GNU General Public License for more details.
14
 
#
15
 
# You should have received a copy of the GNU General Public
16
 
# License along with this program; if not, write to the Free
17
 
# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
18
 
# MA  02111-1307  USA.
19
 
 
20
 
$ENV{'PATH'} = '/bin';
21
 
# Avoid taint problems when any of these environment variables are defined.
22
 
# See perlsec(1) manpage 
23
 
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
24
 
 
25
 
use strict;
26
 
use CGI qw/:standard/;
27
 
 
28
 
# Swish++ module
29
 
use lib qw(/usr/lib/swish++);
30
 
 
31
 
eval {
32
 
        require WWW;
33
 
};
34
 
 
35
 
print header() unless param('file');
36
 
print start_html(-title=>'Debian Online Help: Search Result',
37
 
                                 -author=>'dhelp@packages.debian.org'), "\n";
38
 
if (param('file')) {
39
 
        print img({src=>'file:/usr/share/doc/dhelp/debian.jpg',alt=>'Debian GNU/Linux'}), "\n";
40
 
} else {
41
 
        print img({src=>'/doc/dhelp/debian.jpg',alt=>'Debian GNU/Linux'}), "\n";
42
 
print p();
43
 
}
44
 
 
45
 
unless (-x '/usr/bin/search++') {
46
 
    print "No search engine installed. Please install swish++.<BR>";
47
 
        print end_html();
48
 
        exit 0;
49
 
}
50
 
 
51
 
unless (-f '/var/lib/dhelp/swish++.index') {
52
 
    print q{No search database found.<BR>
53
 
Please run /etc/cron.weekly/dhelp as superuser to create it.<BR>};                      
54
 
        print end_html();
55
 
        exit 0;
56
 
}
57
 
 
58
 
# Fetch, untaint and check search parameter
59
 
my $search = param('search');
60
 
$search =~ m/([\w\d\@._-]+)/;
61
 
$search = $1;
62
 
 
63
 
if ($search !~ /\S/) {
64
 
        print "Please specify a search token.<BR>";
65
 
        print end_html();
66
 
        exit 0;
67
 
}
68
 
 
69
 
# Pass parameters to Swish++ search program
70
 
open (SEARCH, '-|')
71
 
        or exec '/usr/bin/search++', '-i', '/var/lib/dhelp/swish++.index', $search;
72
 
 
73
 
##
74
 
# Header HTML
75
 
##
76
 
my $chunk = <<END;
77
 
<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>
78
 
END
79
 
 
80
 
##
81
 
# Read the search results back.
82
 
##
83
 
my $ignored;
84
 
while ( <SEARCH> ) {
85
 
        if ( /^\# ignored: / ) {
86
 
                ##
87
 
                # Get the ignored words so we can report them to the user.
88
 
                ##
89
 
                $ignored = $';
90
 
                $ignored = s/\s+$//;
91
 
                next;
92
 
        }
93
 
        if ( /^\# results: (\d+)/ && ! $1) {
94
 
                $chunk = '';
95
 
                if ($ignored) {
96
 
                        print "No results (Ignored: $ignored).<BR>";
97
 
                } else {
98
 
                    print "No results.<BR>";
99
 
                }
100
 
                last;
101
 
        }
102
 
        print $chunk;
103
 
        ##
104
 
        # Future releases of SWISH++ may emit other comments: ignore ones we
105
 
        # don't know about.
106
 
        ##
107
 
        next if /^\#/;
108
 
 
109
 
        my( $rank, $file, $size, $title ) = split( / /, $_, 4 );
110
 
 
111
 
        my $desc = WWW::extract_description( "$file" );
112
 
        WWW::hyperlink( $desc );
113
 
        $size = int( $size / 1024 );
114
 
        if ( $size ) {
115
 
                $size .= 'K';
116
 
        } else {
117
 
                $size = '&lt;1K';
118
 
        }
119
 
        if (param('file')) {
120
 
                $file = "file:$file";
121
 
        } else {
122
 
                $file =~ s%^/usr/share/%/%;
123
 
        }
124
 
        unless ($title =~ /\S/ ) {
125
 
                $title = $file;
126
 
        }
127
 
        $chunk = <<END;
128
 
        <TR VALIGN=top><TD ALIGN=right>$rank%&nbsp;&nbsp;</TD>
129
 
        <TD><DL><DT><B><A HREF="$file">$title</A></B> ($size)<DD>$desc</DL></TD>
130
 
END
131
 
}
132
 
 
133
 
if ($chunk) {
134
 
        print "$chunk</TABLE>\n";
135
 
}
136
 
 
137
 
close (SEARCH);
138
 
 
139
 
print end_html(), "\n";
140
 
 
141
 
__END__
142
 
 
143