/[wait]/branches/CPAN/script/sman.PL
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /branches/CPAN/script/sman.PL

Parent Directory Parent Directory | Revision Log Revision Log


Revision 11 - (show annotations)
Fri Apr 28 15:41:10 2000 UTC (24 years ago) by unknown
File MIME type: text/plain
File size: 8780 byte(s)
This commit was manufactured by cvs2svn to create branch 'CPAN'.
1 #!/bin/sh -- # -*- perl -*- -w
2 eval 'exec perl -S $0 "$@"'
3 if 0;
4
5 use strict;
6
7 use Config;
8 use File::Basename qw(fileparse);
9
10 my($file, $path) = fileparse($0);
11 $file =~ s!\.PL$!!i;
12 chdir($path) or die "Couldn't chdir to `$path': $!\n";
13
14 print "Extracting $file\n";
15
16 open(OUT, "> $file") or die "Couldn't create `$file': $!\n";
17 print OUT "$Config{'startperl'} -w\n";
18 while (<DATA>) {
19 print OUT
20 }
21 close(OUT) or die "Couldn't close `$file': $!\n";
22
23 chmod(0755, $file) or die "Couldn't chmod 744 on `$file': $!\n";
24
25 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
26
27 __END__
28 ######################### -*- Mode: Perl -*- #########################
29 ##
30 ## $Basename: sman.PL $
31 ## $Revision: 1.6 $
32 ##
33 ## Author : Ulrich Pfeifer
34 ## Created On : Fri Aug 30 15:52:25 1996
35 ##
36 ## Last Modified By : Ulrich Pfeifer
37 ## Last Modified On : Sun Nov 22 18:44:34 1998
38 ##
39 ## Copyright (c) 1996-1997, Ulrich Pfeifer
40 ##
41 ##
42 ######################################################################
43
44 eval 'exec perl -S $0 "$@"'
45 if 0;
46
47
48 use strict;
49
50
51 use Term::ReadLine;
52 use Getopt::Long;
53 use Fcntl;
54
55 require WAIT::Config;
56 require WAIT::Database;
57 require WAIT::Query::Base;
58 require WAIT::Query::Wais;
59
60
61 $SIG{PIPE} = 'IGNORE';
62 my %OPT = (database => 'DB',
63 dir => $WAIT::Config->{WAIT_home} || '/tmp',
64 table => 'man',
65 pager => $WAIT::Config->{'pager'} || 'more',
66 filter => 0,
67 max => 15,
68 );
69
70 GetOptions(\%OPT,
71 'database=s',
72 'dir=s',
73 'table=s',
74 'filter=i',
75 'max=i',
76 'pager:s') || die "Usage: ...\n";
77
78 my $db = WAIT::Database->open(name => $OPT{database},
79 mode => O_RDONLY,
80 directory => $OPT{dir})
81 or die "Could not open database $OPT{database}: $@";
82
83 my $tb = $db->table(name => $OPT{table})
84 or die "Could not open table $OPT{table}: $@";
85
86 my $layout = $tb->layout;
87
88 my $did;
89 my @did;
90 my @stack;
91
92 my $term = new Term::ReadLine 'Simple Query Interface';
93
94 require WAIT::Format::Term;
95 my $format;
96 if ($Config::Config{'archname'} eq 'i586-linux') {
97 # for color xterm
98 $format = new WAIT::Format::Term query_s => "", query_e => "";
99 } else {
100 $format = new WAIT::Format::Term;
101 }
102
103 my $pager = ($OPT{pager})?\&less : \&pager;
104 my $OUT = $term->OUT;
105
106 my $st = 1;
107 print $OUT "Enter 'h' for help.\n";
108
109 my (%hits, $query, $query_text);
110 while (defined ($_ = &readline("$st>"))) {
111 chomp; $st++;
112 if (/^$/) {
113 next;
114 } elsif (/^m (\d+)$/) {
115 $OPT{max} = $1;
116 } elsif (/^f\s*(\d+)?$/) {
117 $OPT{filter} = $1;
118 next;
119 } elsif (/^t$/i) {
120 if ($pager eq \&less) {
121 $pager = \&pager;
122 } else {
123 $pager = \&less;
124 }
125 next;
126 } elsif (/^(\d+)$/) {
127 if (defined $did[$1]) {
128 display($did[$1]);
129 next;
130 }
131 } elsif (/^d\s*(\d+)/) {
132 if (defined $did[$1]) {
133 view($did[$1]);
134 next;
135 }
136 } elsif (/^q$/i) {
137 last;
138 } elsif (/^l$/i) {
139 # fall through
140 } elsif (/^[h?]$/i) {
141 help();
142 next;
143 } elsif (/^hh$/i) {
144 extended_help();
145 next;
146 } else {
147 $query_text = $_;
148 eval {$query = WAIT::Query::Wais::query($tb, $_)};
149 if ($@ ne '') {
150 print $OUT "$_ => $query\n\$\@='$@'\n";
151 } elsif (ref($query)) {
152 %hits = $query->execute();
153 } else {
154 next;
155 }
156 }
157
158 next unless %hits;
159 my $no = 1; @did = ();
160 print "Query: $query_text\n";
161 for $did (sort {$hits{$b} <=> $hits{$a}} keys %hits) {
162 my %tp = $tb->fetch($did);
163 printf $OUT "%2d %6.3f %s\n", $no, $hits{$did},
164 substr($tp{headline} ||'',0,68);
165 $did[$no] = $did;
166 last if $no++ >= $OPT{max};
167 }
168 } continue {
169 # we don't do this since ANdreas Koenig does not think of it as feature
170 # $term->SetHistory(grep length($_)>4, $term->GetHistory)
171 }
172
173 sub readline {
174 if (@ARGV) {
175 shift @ARGV;
176 } else {
177 $term->readline(@_);
178 }
179 }
180 sub help {
181 my $idb = "\n\t'". join(q[', '], $tb->fields()) . "'";
182 print $OUT qq[Available commands:
183
184 <num> Show the document <num>
185 d <num> Show the db entry of document <num>
186 f <num> Display only <num> lines context
187 h,? Display this help message
188 hh Display query examples
189 m <num> Set maxhits to <num>
190 t Toggle display mode (term/less)
191 q Exit from $0
192 l redisplay last ranking
193 Other input is tried as wais query.
194 The following fields are known: $idb
195 ] ;
196 }
197
198 sub extended_help {
199 print q{
200 Here are some query examples:
201
202 information retrieval free text query
203 information or retrieval same as above
204 des=information retrieval `information' must be in the description
205 des=(information retrieval) one of them in description
206 des=(information or retrieval) same as above
207 des=(information and retrieval) both of them in description
208 des=(information not retrieval) `information' in description and
209 `retrieval' not in description
210 des=(information system*) wild-card search
211 au=ilia author names may be misspelled
212
213 You can build arbitary boolean combination of the above examples.
214 Filed names may be abbreviated.
215 }
216 }
217
218 sub view {
219 my $did = shift;
220 my %tp = $tb->fetch($did);
221 for (keys %tp) {
222 print $OUT "$_ $tp{$_}\n";
223 }
224 }
225
226 sub display {
227 my $did = shift;
228
229 return unless defined $query and defined $did;
230
231 print $OUT "Wais display document $did\n";
232 my %tp = $tb->fetch($did);
233 my $tdid = $tp{docid};
234 if ($tdid !~ m(^/)) {
235 $tdid = $tb->dir . '/' . $tdid;
236 }
237 my $buf = $tb->fetch_extern($tdid);
238 if ($buf) {
239 my @txt = $query->hilight($buf);
240 if ($OPT{filter}) {
241 @txt = &filter(@txt);
242 }
243 &$pager($format->as_string(\@txt));
244 }
245 }
246
247 sub filter {
248 my @result;
249 my @context;
250 my $lines = 0;
251 my $clines = 0;
252 my $elipsis = 0;
253
254 print STDERR "Filter ...";
255 while (@_) {
256 my %tag = %{shift @_};
257 my $txt = shift @_;
258
259 for (split /(\n)/, $txt) {
260 if ($_ eq "\n") {
261 if (exists $tag{_qt}) {
262 #die "Weird!";
263 push @result, {_i=>1}, "[WEIRD]";
264 } elsif ($lines) {
265 push @result, {}, $_;
266 $lines--;
267 } else {
268 push @context, {}, $_;
269 $clines++;
270 }
271 } else {
272 if (exists $tag{_qt}) {
273 push @result, {_i=>1}, "\n[ $elipsis linesĀ ]\n" if $elipsis;
274 push @result, @context, {%tag}, $_;
275 delete $tag{_qt};
276 @context = (); $clines = 0; $elipsis=0;
277 $lines = $OPT{filter}+1;
278 } elsif ($lines) {
279 push @result, \%tag, $_;
280 } else {
281 push @context, \%tag, $_;
282 }
283 }
284 if ($clines>$OPT{filter}) {
285 my (%tag, $txt);
286 while ($clines>$OPT{filter}) {
287 %tag = %{shift @context};
288 $txt = shift @context;
289 if ($txt =~ /\n/) {
290 $clines--;
291 $elipsis++;
292 }
293 }
294 }
295 }
296 }
297 print STDERR " done\n";
298 @result;
299 }
300
301 sub less {
302 my $flags;
303 if ($WAIT::Config->{pager} =~ /less/) {
304 $flags = '-r';
305 } elsif ($WAIT::Config->{pager} =~ /more/) {
306 $flags = '-c';
307 }
308 open(PAGER, "|$WAIT::Config->{pager} $flags") or die;
309 print PAGER @_;
310 close PAGER;
311 }
312
313 sub pager {
314 my @lines = split /\n/, $_[0];
315 my $line = 0;
316 for (@lines) {
317 print "$_\n"; $line++;
318 if ($line % 24 == 0) {
319 my $key = readline("[return]");
320 return if $key =~ /^q/i;
321 }
322 }
323 }
324
325
326 __END__
327 ## ###################################################################
328 ## pod
329 ## ###################################################################
330
331 =head1 NAME
332
333 sman - Search and disply manuals interactive
334
335 =head1 SYNOPSIS
336
337 B<sman>
338 [B<-database> I<database name>]
339 [B<-dir> I<database directory>]
340 [B<-table> I<name>]
341 [B<-less>]
342 [B<-filter> I<num>]
343 [B<-max> I<num>]
344
345 =head1 DESCRIPTION
346
347 B<Sman> is an interactive search interface to your systems manual pages.
348
349 =head2 OPTIONS
350
351 =over 10
352
353 =item B<-database> I<database name>
354
355 Change the default database name to I<database name>.
356
357 =item B<-dir> I<database directory>
358
359 Change the default database directory to I<database directory>.
360
361 =item B<-table> I<name>
362
363 Use I<name> instead of C<man> as table name.
364
365 =item B<-pager> I<name>
366
367 Use I<name> instead of the default pager. If no I<name> is supplied a
368 buildin pager is used.
369
370 =item B<-filter> I<num>
371
372 Display only I<num> lines above and below an occurance of a search
373 term in the manual.
374
375 =item B<-max> I<num>
376
377 Display only I<num> hits. Default is to 10.
378
379 =head1 SEE ALSO
380
381 L<smakewhatis>.
382
383 =head1 AUTHOR
384
385 Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>

Properties

Name Value
cvs2svn:cvs-rev 1.1
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26