/[wait]/branches/CPAN/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

Contents of /branches/CPAN/script/pmakewhatis.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: 5723 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: 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