/[wait]/cvs-head/script/pmakewhatis.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/pmakewhatis.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: 5723 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: pmakewhatis.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:35 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::Config;
57     require WAIT::Database;
58     require WAIT::Parse::Pod;
59     require WAIT::Document::Find;
60    
61    
62     my %OPT = (database => 'DB',
63     dir => $WAIT::Config->{WAIT_home} || '/tmp',
64     table => 'pod',
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}/$OPT{table}") {
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     }
90     unless (-d "$OPT{dir}/$OPT{database}") {
91     $db = WAIT::Database->create(name => $OPT{database},
92     'directory' => $OPT{dir})
93     or die "Could not open database $OPT{database}: $@";
94     } else {
95     $db = WAIT::Database->open(name => $OPT{database},
96     'directory' => $OPT{dir})
97     or die "Could not open table $OPT{table}: $@";
98     }
99    
100    
101    
102     my $layout= new WAIT::Parse::Pod;
103     my $stem = [{
104     'prefix' => ['isotr', 'isolc'],
105     'intervall' => ['isotr', 'isolc'],
106     }, 'isotr', 'isolc', 'split2', 'stop', 'Stem'];
107     my $text = [{
108     'prefix' => ['isotr', 'isolc'],
109     'intervall' => ['isotr', 'isolc'],
110     },
111     'isotr', 'isolc', 'split2', 'stop'];
112     my $sound = ['isotr', 'isolc', 'split2', 'Soundex'],;
113    
114     my %D;
115    
116     my @DIRS;
117     if (@ARGV) {
118     @DIRS = @ARGV;
119     } else {
120     @DIRS = grep $_ !~ /^\./, @INC;
121     }
122    
123     my $access = tie %D, WAIT::Document::Find, sub { $_[0] =~ /\.(pod|pm)$/}, @DIRS;
124     die $@ unless defined $access;
125    
126     my $tb = $db->table(name => $OPT{table}) ||
127     $db->create_table
128     (name => $OPT{table},
129     attr => ['docid', 'headline', 'size'],
130     keyset => [['docid']],
131     layout => $layout,
132     access => $access,
133     invindex =>
134     [
135     'name' => $stem,
136     'synopsis' => $stem,
137     'bugs' => $stem,
138     'description' => $stem,
139     'text' => $stem,
140     'environment' => $text,
141     'example' => $text, 'example' => $stem,
142     'author' => $sound, 'author' => $stem,
143     ]
144     );
145     die unless $tb;
146    
147    
148     my $podfile = $access->FIRSTKEY;
149     do {
150     unless ($podfile =~ /^$OPT{dir}/o) {
151     &index($podfile);
152     }
153     } while ($podfile = $access->NEXTKEY);
154    
155     $db->close();
156     exit;
157    
158     my $NO;
159     sub index {
160     my $did = shift;
161    
162     if ($tb->have('docid' => $did)) {
163     #die "$@" if $2 ne '';
164     if (!$OPT{remove}) {
165     print "duplicate\n";
166     return;
167     }
168     } elsif ($OPT{remove}) {
169     print "missing\n";
170     return;
171     }
172    
173     my $value = $D{$did};
174     unless (defined $value) {
175     print "unavailable\n";
176     }
177     printf STDERR "ok [%d] ", ++$NO;
178    
179     my $record = $layout->split($value);
180     $record->{size} = length($value);
181     my $headline = $record->{name} || $did;
182     $headline =~ s/\s+/ /g; $headline =~ s/^\s+//;
183     printf "%s\n", substr($headline,0,70);
184     if ($OPT{remove}) {
185     $tb->delete('docid' => $did, headline => $headline, %{$record});
186     } else {
187     $tb->insert('docid' => $did, headline => $headline, %{$record});
188     }
189     }
190    
191    
192     __END__
193     ## ###################################################################
194     ## pod
195     ## ###################################################################
196    
197     =head1 NAME
198    
199     pmakewhatis - generate a manual database for sman
200    
201     =head1 SYNOPSIS
202    
203     B<smakewhatis>
204     [B<-database> I<database name>]
205     [B<-dir> I<database directory>]
206     [B<-table> I<name>]
207     [B<-remove>]
208     [I<mandir> ...]
209    
210     =head1 DESCRIPTION
211    
212     B<Pmakewhatis> generates/updates databases for B<sman>(1). If
213     I<mandir>s are specified, these are used. Otherwise directories in
214     C<@INC> are indexed.
215    
216     =head2 OPTIONS
217    
218     =over 10
219    
220     =item B<-database> I<database name>
221    
222     Change the default database name to I<database name>.
223    
224     =item B<-dir> I<database directory>
225    
226     Change the default database directory to I<database directory>.
227    
228     =item B<-table> I<name>
229    
230     Use I<name> instead of C<pod> as table name.
231    
232     =item B<-clean>
233    
234     Clean B<database> before indexing.
235    
236     =item B<-remove>
237    
238     Remove the selected directories from the database instead of
239     adding/updating. This works only for the pod files which are unchanged
240     since the indexing.
241    
242     =head1 SEE ALSO
243    
244     L<sman>.
245    
246     =head1 AUTHOR
247    
248     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