/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 11 - (hide annotations)
Fri Apr 28 15:41:10 2000 UTC (24 years, 1 month ago) by unknown
File MIME type: text/plain
File size: 8780 byte(s)
This commit was manufactured by cvs2svn to create branch 'CPAN'.
1 ulpfr 10 #!/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