← Back to branch summary

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

« back to all changes in this revision

Viewing changes to tmp/dhelp-ruby/dhelp

  • 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:
tmp/dhelp-ruby/dhelp
1
 
#!/usr/bin/perl -w
2
 
#
3
 
# Copyright 2002 by Stefan Hornburg (Racke) <racke@linuxia.de>
4
 
#
5
 
# Based on a sample implementation of Chris Tillman
6
 
# <tillman@azstarnet.com>.
7
 
#
8
 
# This program is free software; you can redistribute it and/or modify
9
 
# it under the terms of the GNU General Public License as published by
10
 
# the Free Software Foundation; either version 2 of the License, or
11
 
# (at your option) any later version.
12
 
#
13
 
# This program is distributed in the hope that it will be useful,
14
 
# but WITHOUT ANY WARRANTY; without even the implied warranty of
15
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
 
# GNU General Public License for more details.
17
 
#
18
 
# You should have received a copy of the GNU General Public
19
 
# License along with this program; if not, write to the Free
20
 
# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
21
 
# MA  02111-1307  USA.
22
 
 
23
 
use strict;
24
 
use warnings;
25
 
 
26
 
# module setup
27
 
use File::Spec;
28
 
use File::Temp qw(tempfile);
29
 
use IO::Socket;
30
 
use Getopt::Long;
31
 
use Pod::Usage;
32
 
 
33
 
# version (replaced on packaging time)
34
 
my $version = '__VERSION__';
35
 
 
36
 
sub fatal_error {
37
 
        chomp(my $msg = shift );
38
 
        print STDERR $msg, "\n";
39
 
        sleep 3;
40
 
        exit 1;
41
 
}
42
 
 
43
 
# process commandline options
44
 
my %opts;
45
 
my $whandler = $SIG{__WARN__};
46
 
$SIG{__WARN__} = sub {print STDERR "$0: @_";};
47
 
unless (GetOptions(\%opts,
48
 
                                   'file|f',
49
 
                                   'help|h',
50
 
                                   'version')) {
51
 
        fatal_error(pod2usage(1));
52
 
}
53
 
 
54
 
if ($opts{help}) {
55
 
        pod2usage(1);
56
 
        exit 0;
57
 
} elsif ($opts{version}) {
58
 
        print "dhelp version $version\n";
59
 
        exit 0;
60
 
}
61
 
 
62
 
my $searchterm = shift;
63
 
 
64
 
# home directory of the current user
65
 
my $homedir;
66
 
 
67
 
if (exists $ENV{'HOME'} && -d $ENV{'HOME'}) {
68
 
        $homedir = $ENV{'HOME'};
69
 
} else {
70
 
    $homedir = (getpwent()) [7];
71
 
}
72
 
 
73
 
# always use sensible-browser
74
 
my $browser = "/usr/bin/sensible-browser";
75
 
 
76
 
my $httpd_running = '';
77
 
 
78
 
unless ($opts{file}) {
79
 
        # check if there is a CGI capable WWW server running on the localhost
80
 
        my $testdoc = "/doc/HTML/index.html";
81
 
        my $eol = "\015\012";
82
 
        my $blank = $eol x 2;
83
 
        my $sock = IO::Socket::INET->new('127.0.0.1:80');
84
 
 
85
 
        if ($sock) {
86
 
                $sock->autoflush(1);
87
 
                print $sock "HEAD $testdoc HTTP/1.0$eol";
88
 
                print $sock "Host: localhost" . $blank;
89
 
 
90
 
                while (my $line = <$sock>) {
91
 
                        if ($line =~ s/^Server: //) {
92
 
                                $httpd_running = $line;
93
 
                                $httpd_running =~ s/\r?\n?//go;
94
 
                        }
95
 
                }
96
 
                close $sock;
97
 
 
98
 
                if ($httpd_running =~ /dhttpd/) {
99
 
                        # this server is not CGI capable
100
 
                        $httpd_running = '';
101
 
                }
102
 
        }
103
 
}
104
 
 
105
 
my $document;
106
 
 
107
 
if ($httpd_running) {
108
 
        # we can query the web server directly
109
 
        if ($searchterm) {
110
 
                $document="http://localhost/cgi-bin/dsearch?search=$searchterm";
111
 
        } else {
112
 
                $document="http://localhost/doc/HTML/index.html";
113
 
        }
114
 
        print "Starting browser (using HTTP $httpd_running) ...\n";
115
 
} else {
116
 
        if ($searchterm) {
117
 
                my ($basedir) = File::Spec->tmpdir();
118
 
                my ($fh, $tmpfile) = tempfile ('dhelp' . 'X' x 6,
119
 
                                                                           DIR => $basedir,
120
 
                                                                           SUFFIX => '.html',
121
 
                                                                           UNLINK => 1);
122
 
                print "Starting dsearch for $searchterm\n";
123
 
                # call dsearch
124
 
                open (DSEARCH, "/usr/lib/cgi-bin/dsearch file=1 search=$searchterm|");
125
 
                while (<DSEARCH>) {
126
 
                        print $fh $_;
127
 
                }
128
 
                close (DSEARCH) || fatal_error "$0: dsearch failed\n";
129
 
                system ( "$browser $tmpfile" ) and fatal_error( "${browser}: Failed to open $tmpfile: $!\n" );
130
 
                exit 0;
131
 
        } else {
132
 
                $document="/usr/share/doc/HTML/index.html";
133
 
                print "Starting browser (using local filesystem) ...\n";
134
 
        }
135
 
}
136
 
 
137
 
system ( "$browser $document" ) and fatal_error( "${browser}: Failed to open $document: $!\n" );
138
 
 
139
 
__END__
140
 
 
141
 
 
142
 
=head1 NAME
143
 
 
144
 
dhelp - Accessing Debian Online Help System
145
 
 
146
 
=head1 SYNOPSIS
147
 
 
148
 
   dhelp [ -h | -v | search-term ]
149
 
   dhelp -f
150
 
 
151
 
=head1 OPTIONS
152
 
 
153
 
=over 8
154
 
 
155
 
=item B<-f, --file>
156
 
 
157
 
Direct the browser to use the local file system instead of
158
 
contacting the local WWW server.
159
 
 
160
 
=item B<-h, --help>
161
 
 
162
 
Show a brief help message and exit.
163
 
 
164
 
=item B<-v, --version>
165
 
 
166
 
Show the program version number and exit.
167
 
 
168
 
=back
169
 
 
170
 
=head1 DESCRIPTION
171
 
 
172
 
B<dhelp> presents a list of installed html documentation. The
173
 
list can be browsed directly with Lynx, or if a web server
174
 
is installed then any web browser can be used.
175
 
 
176
 
In addition, you can search for terms indexed in the documentation
177
 
using B<dhelp search-term> .
178
 
 
179
 
=cut
180
 
 
181