/[wait]/cvs-head/script/smakewhatis.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 /cvs-head/script/smakewhatis.PL

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (hide annotations)
Fri Apr 28 15:40:52 2000 UTC (24 years ago) by ulpfr
File MIME type: text/plain
File size: 6340 byte(s)
Initial revision

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: smakewhatis.PL $
31     ## $Revision: 1.6 $
32     ##
33     ## Author : Ulrich Pfeifer
34     ## Created On : Mon Sep 2 12:57:12 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 FileHandle;
52     use File::Path;
53     use DB_File;
54     use Getopt::Long;
55    
56     require WAIT::Database;
57     require WAIT::Config;
58     require WAIT::Parse::Nroff;
59     require WAIT::Document::Nroff;
60    
61    
62     my %OPT = (database => 'DB',
63     dir => $WAIT::Config->{WAIT_home} || '/tmp',
64     table => 'man',
65     clean => 0,
66     remove => 0,
67     );
68    
69     GetOptions(\%OPT,
70     'database=s',
71     'dir=s',
72     'table=s',
73     'clean!',
74     'remove',
75     ) || die "Usage: ...\n";
76    
77     my $db;
78     if ($OPT{clean} and -d "$OPT{dir}/$OPT{database}") {
79     eval {
80     my $tmp = WAIT::Database->open(name => $OPT{database},
81     'directory' => $OPT{dir})
82     or die "Could not open table $OPT{table}: $@";
83     my $tbl = $tmp->table(name => $OPT{table});
84     $tbl->drop if $tbl;
85     $tmp->close;
86     rmtree("$OPT{dir}/$OPT{database}/$OPT{table}",1,1)
87     if -d "$OPT{dir}/$OPT{database}/$OPT{table}";
88     };
89     exit;
90     }
91     unless (-d "$OPT{dir}/$OPT{database}") {
92     $db = WAIT::Database->create(name => $OPT{database},
93     'directory' => $OPT{dir})
94     or die "Could not open database $OPT{database}: $@";
95     } else {
96     $db = WAIT::Database->open(name => $OPT{database},
97     'directory' => $OPT{dir})
98     or die "Could not open table $OPT{table}: $@";
99     }
100    
101    
102    
103     my $layout= new WAIT::Parse::Nroff;
104     my $stem = [{
105     'prefix' => ['unroff', 'isotr', 'isolc'],
106     'intervall' => ['unroff', 'isotr', 'isolc'],
107     },'unroff', 'isotr', 'isolc', 'split2', 'stop', 'Stem'];
108     my $text = [{
109     'prefix' => ['unroff', 'isotr', 'isolc'],
110     'intervall' => ['unroff', 'isotr', 'isolc'],
111     },
112     'unroff', 'isotr', 'isolc', 'split2', 'stop'];
113     my $sound = ['unroff', 'isotr', 'isolc', 'split2', 'Soundex'],;
114    
115     my %D;
116    
117     my $access = tie %D, WAIT::Document::Nroff, 'nroff -man';
118     die $@ unless defined $access;
119    
120     my $tb = $db->table(name => $OPT{table}) ||
121     $db->create_table
122     (name => $OPT{table},
123     attr => ['docid', 'headline', 'size'],
124     keyset => [['docid']],
125     layout => $layout,
126     access => $access,
127     invindex =>
128     [
129     'name' => $stem,
130     'synopsis' => $stem,
131     'bugs' => $stem,
132     'description' => $stem,
133     'text' => $stem,
134     'environment' => $text,
135     'example' => $text, 'example' => $stem,
136     'author' => $sound, 'author' => $stem,
137     ]
138     );
139     die unless $tb;
140    
141     my @DIRS;
142     if (@ARGV) {
143     @DIRS = @ARGV;
144     } else {
145     @DIRS = @{$WAIT::Config->{manpath}};
146     }
147    
148     my $mandir;
149     for $mandir (grep -d $_, @DIRS) {
150     opendir(DIR, $mandir) or warn "Could not open dir '$mandir': $!";
151     my @mdir = grep -d "$mandir/$_", grep /^man/, readdir(DIR);
152     closedir DIR;
153     my $section;
154     for $section (@mdir) {
155     my $file;
156     print STDERR "Scanning '$mandir/$section' ...\n";
157     opendir(DIR, "$mandir/$section")
158     or warn "Could not open dir '$mandir/section': $!";
159     my @files = grep -f "$mandir/$section/$_", grep $_ !~ /^\./, readdir(DIR);
160     closedir DIR;
161     for $file ( @files ) {
162     print STDERR "Indexing '$mandir/$section/$file' ... ";
163     &index("$mandir/$section/$file");
164     }
165     }
166     }
167     $db->close();
168     exit;
169    
170     my $NO;
171     sub index {
172     my $did = shift;
173    
174     if ($tb->have('docid' => $did)) {
175     #die "$@" if $2 ne '';
176     if (!$OPT{remove}) {
177     print "duplicate\n";
178     return;
179     }
180     } elsif ($OPT{remove}) {
181     print "missing\n";
182     return;
183     }
184    
185     if (-s $did < 100) {
186     print "too small\n";
187     return;
188     }
189    
190     my $value = $D{$did};
191     unless (defined $value) {
192     print "unavailable\n";
193     }
194     printf STDERR "ok [%d]\n", ++$NO;
195    
196     my $record = $layout->split($value);
197     $record->{size} = length($value);
198     my $headline = $record->{name} || $did;
199     $headline =~ s/\s+/ /g; $headline =~ s/^\s+//;
200     printf "%s\n", substr($headline,0,80);
201     if ($OPT{remove}) {
202     $tb->delete('docid' => $did, headline => $headline, %{$record});
203     } else {
204     $tb->insert('docid' => $did, headline => $headline, %{$record});
205     }
206     }
207    
208    
209     __END__
210     ## ###################################################################
211     ## pod
212     ## ###################################################################
213    
214     =head1 NAME
215    
216     smakewhatis - generate a manual database for sman
217    
218     =head1 SYNOPSIS
219    
220     B<smakewhatis>
221     [B<-database> I<database name>]
222     [B<-dir> I<database directory>]
223     [B<-table> I<name>]
224     [B<-remove>]
225     [I<mandir> ...]
226    
227     =head1 DESCRIPTION
228    
229     B<Smakewhatis> generates/updates databases for B<sman>(1). If
230     I<mandir>s are specified, these are used. Otherwise the confiigured
231     default directories are indexed.
232    
233     =head2 OPTIONS
234    
235     =over 10
236    
237     =item B<-database> I<database name>
238    
239     Change the default database name to I<database name>.
240    
241     =item B<-dir> I<database directory>
242    
243     Change the default database directory to I<database directory>.
244    
245     =item B<-table> I<name>
246    
247     Use I<name> instead of C<man> as table name.
248    
249     =item B<-clean>
250    
251     Clean B<database> before indexing.
252    
253     =item B<-remove>
254    
255     Remove the selected directories from the database instead of
256     adding/updating. This works only for the manuals which are unchanged
257     since the indexing.
258    
259     =head1 SEE ALSO
260    
261     L<sman>.
262    
263     =head1 AUTHOR
264    
265     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