Annotation of /trunk/script/pmakewhatis

#!/usr/local/perl5.005_56.Mar06/bin/perl -w
######################### -*- Mode: Perl -*- #########################
##
## $Basename: pmakewhatis $
## $Revision: 1.7 $
##
## Author           : Ulrich Pfeifer
## Created On       : Mon Sep  2 12:57:12 1996
##
## Last Modified By : Ulrich Pfeifer
## Last Modified On : Sun Nov 22 18:44:35 1998
## 
## Copyright (c) 1996-1997, Ulrich Pfeifer
## 
## 
######################################################################

eval 'exec perl -S $0 "$@"'
  if 0;


use strict;


use FileHandle;
use File::Path;
use DB_File;
use Getopt::Long;

require WAIT::Config;
require WAIT::Database;
require WAIT::Parse::Pod;
require WAIT::Document::Find;


my %OPT = (database => 'DB',
           dir      => $WAIT::Config->{WAIT_home} || '/tmp',
           table    => 'pod',
           clean    => 0,
           remove   => 0,
          );

GetOptions(\%OPT,
           'database=s',
           'dir=s',
           'table=s',
           'clean!',
           'remove',
          ) || die "Usage: ...\n";

my $db;
if ($OPT{clean} and -d "$OPT{dir}/$OPT{database}/$OPT{table}") {
  eval {
    my $tmp = WAIT::Database->open(name        => $OPT{database},
                                   'directory' => $OPT{dir})
      or die "Could not open table $OPT{table}: $@";
    my $tbl = $tmp->table(name => $OPT{table});
    $tbl->drop if $tbl;
    $tmp->close;
    rmtree("$OPT{dir}/$OPT{database}/$OPT{table}",1,1)
      if -d "$OPT{dir}/$OPT{database}/$OPT{table}";
  };
}
unless (-d "$OPT{dir}/$OPT{database}") {
  $db = WAIT::Database->create(name       => $OPT{database},
                              'directory' => $OPT{dir})
    or die "Could not open database $OPT{database}: $@";
} else {
  $db = WAIT::Database->open(name        => $OPT{database},
                             'directory' => $OPT{dir})
    or die "Could not open table $OPT{table}: $@";
}


my $layout= new WAIT::Parse::Pod;
my $stem = [{
             'prefix'    => ['isotr', 'isolc'],
             'intervall' => ['isotr', 'isolc'],
            }, 'isotr', 'isolc', 'split2', 'stop', 'Stem'];
my $text = [{
             'prefix'    => ['isotr', 'isolc'],
             'intervall' => ['isotr', 'isolc'],
            },
             'isotr', 'isolc', 'split2', 'stop'];
my $sound = ['isotr', 'isolc', 'split2', 'Soundex'],;

my %D;

my @DIRS;
if (@ARGV) {
  @DIRS = @ARGV;
} else {
  @DIRS  = grep $_ !~ /^\./, @INC;
}

my $access = tie %D, 'WAIT::Document::Find', sub { $_[0] =~ /\.(pod|pm)$/}, @DIRS;
die $@ unless defined $access;

my $tb = $db->table(name => $OPT{table}) ||
  $db->create_table
  (name     => $OPT{table},
   attr     => ['docid', 'headline', 'size'],
   keyset   => [['docid']],
   layout   => $layout,
   access   => $access,
   invindex =>
   [
    'name'         => $stem,
    'synopsis'     => $stem,
    'bugs'         => $stem,
    'description'  => $stem,
    'text'         => $stem,
    'environment'  => $text,
    'example'      => $text,  'example' => $stem,
    'author'       => $sound, 'author'  => $stem,
   ]
  );
die unless $tb;


my $podfile = $access->FIRSTKEY;
do {
  unless ($podfile =~ /^$OPT{dir}/o) {
    &index($podfile);
  }
} while ($podfile = $access->NEXTKEY);

$db->close();
exit;

my $NO;
sub index {
  my $did = shift;

  if ($tb->have('docid' => $did)) {
    #die "$@" if $2 ne '';
    if (!$OPT{remove}) {
      print "duplicate\n";
      return;
    }
  } elsif ($OPT{remove}) {
    print "missing\n";
    return;
  }

  my $value = $D{$did};
  unless (defined $value) {
    print "unavailable\n";
  }
  printf STDERR "ok [%d] ", ++$NO;
  
  my $record   = $layout->split($value);
  $record->{size} = length($value);
  my $headline = $record->{name} || $did;
  $headline =~ s/\s+/ /g; $headline =~ s/^\s+//;
  printf "%s\n", substr($headline,0,70);
  if ($OPT{remove}) {
    $tb->delete('docid' => $did, headline => $headline, %{$record});
  } else {
    $tb->insert('docid' => $did, headline => $headline, %{$record});
  }
}


__END__
## ###################################################################
## pod
## ###################################################################

=head1 NAME

pmakewhatis - generate a manual database for sman

=head1 SYNOPSIS

B<smakewhatis>
[B<-database> I<database name>]
[B<-dir> I<database directory>]
[B<-table> I<name>]
[B<-remove>]
[I<mandir> ...]

=head1 DESCRIPTION

B<Pmakewhatis> generates/updates databases for B<sman>(1). If
I<mandir>s are specified, these are used. Otherwise directories in
C<@INC> are indexed.

=head2 OPTIONS

=over 10

=item B<-database> I<database name>

Change the default database name to I<database name>.

=item B<-dir> I<database directory>

Change the default database directory to I<database directory>.

=item B<-table> I<name>

Use I<name> instead of C<pod> as table name.

=item B<-clean>

Clean B<database> before indexing.

=item B<-remove>

Remove the selected directories from the database instead of
adding/updating. This works only for the pod files which are unchanged
since the indexing.

=back

=head1 SEE ALSO

L<sman>.

=head1 AUTHOR

Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
1	ulpfr	10	#!/usr/local/perl5.005_56.Mar06/bin/perl -w
2			######################### -- Mode: Perl -- #########################
3			##
4			## $Basename: pmakewhatis $
5			## $Revision: 1.7 $
6			##
7			## Author : Ulrich Pfeifer
8			## Created On : Mon Sep 2 12:57:12 1996
9			##
10			## Last Modified By : Ulrich Pfeifer
11			## Last Modified On : Sun Nov 22 18:44:35 1998
12			##
13			## Copyright (c) 1996-1997, Ulrich Pfeifer
14			##
15			##
16			######################################################################
17
18			eval 'exec perl -S $0 "$@"'
19			if 0;
20
21
22			use strict;
23
24
25			use FileHandle;
26			use File::Path;
27			use DB_File;
28			use Getopt::Long;
29
30			require WAIT::Config;
31			require WAIT::Database;
32			require WAIT::Parse::Pod;
33			require WAIT::Document::Find;
34
35
36			my %OPT = (database => 'DB',
37			dir => $WAIT::Config->{WAIT_home} \|\| '/tmp',
38			table => 'pod',
39			clean => 0,
40			remove => 0,
41			);
42
43			GetOptions(\%OPT,
44			'database=s',
45			'dir=s',
46			'table=s',
47			'clean!',
48			'remove',
49			) \|\| die "Usage: ...\n";
50
51			my $db;
52			if ($OPT{clean} and -d "$OPT{dir}/$OPT{database}/$OPT{table}") {
53			eval {
54			my $tmp = WAIT::Database->open(name => $OPT{database},
55			'directory' => $OPT{dir})
56			or die "Could not open table $OPT{table}: $@";
57			my $tbl = $tmp->table(name => $OPT{table});
58			$tbl->drop if $tbl;
59			$tmp->close;
60			rmtree("$OPT{dir}/$OPT{database}/$OPT{table}",1,1)
61			if -d "$OPT{dir}/$OPT{database}/$OPT{table}";
62			};
63			}
64			unless (-d "$OPT{dir}/$OPT{database}") {
65			$db = WAIT::Database->create(name => $OPT{database},
66			'directory' => $OPT{dir})
67			or die "Could not open database $OPT{database}: $@";
68			} else {
69			$db = WAIT::Database->open(name => $OPT{database},
70			'directory' => $OPT{dir})
71			or die "Could not open table $OPT{table}: $@";
72			}
73
74
75
76			my $layout= new WAIT::Parse::Pod;
77			my $stem = [{
78			'prefix' => ['isotr', 'isolc'],
79			'intervall' => ['isotr', 'isolc'],
80			}, 'isotr', 'isolc', 'split2', 'stop', 'Stem'];
81			my $text = [{
82			'prefix' => ['isotr', 'isolc'],
83			'intervall' => ['isotr', 'isolc'],
84			},
85			'isotr', 'isolc', 'split2', 'stop'];
86			my $sound = ['isotr', 'isolc', 'split2', 'Soundex'],;
87
88			my %D;
89
90			my @DIRS;
91			if (@ARGV) {
92			@DIRS = @ARGV;
93			} else {
94			@DIRS = grep $_ !~ /^\./, @INC;
95			}
96
97			my $access = tie %D, 'WAIT::Document::Find', sub { $_[0] =~ /\.(pod\|pm)$/}, @DIRS;
98			die $@ unless defined $access;
99
100			my $tb = $db->table(name => $OPT{table}) \|\|
101			$db->create_table
102			(name => $OPT{table},
103			attr => ['docid', 'headline', 'size'],
104			keyset => [['docid']],
105			layout => $layout,
106			access => $access,
107			invindex =>
108			[
109			'name' => $stem,
110			'synopsis' => $stem,
111			'bugs' => $stem,
112			'description' => $stem,
113			'text' => $stem,
114			'environment' => $text,
115			'example' => $text, 'example' => $stem,
116			'author' => $sound, 'author' => $stem,
117			]
118			);
119			die unless $tb;
120
121
122			my $podfile = $access->FIRSTKEY;
123			do {
124			unless ($podfile =~ /^$OPT{dir}/o) {
125			&index($podfile);
126			}
127			} while ($podfile = $access->NEXTKEY);
128
129			$db->close();
130			exit;
131
132			my $NO;
133			sub index {
134			my $did = shift;
135
136			if ($tb->have('docid' => $did)) {
137			#die "$@" if $2 ne '';
138			if (!$OPT{remove}) {
139			print "duplicate\n";
140			return;
141			}
142			} elsif ($OPT{remove}) {
143			print "missing\n";
144			return;
145			}
146
147			my $value = $D{$did};
148			unless (defined $value) {
149			print "unavailable\n";
150			}
151			printf STDERR "ok [%d] ", ++$NO;
152
153			my $record = $layout->split($value);
154			$record->{size} = length($value);
155			my $headline = $record->{name} \|\| $did;
156			$headline =~ s/\s+/ /g; $headline =~ s/^\s+//;
157			printf "%s\n", substr($headline,0,70);
158			if ($OPT{remove}) {
159			$tb->delete('docid' => $did, headline => $headline, %{$record});
160			} else {
161			$tb->insert('docid' => $did, headline => $headline, %{$record});
162			}
163			}
164
165
166			__END__
167			## ###################################################################
168			## pod
169			## ###################################################################
170
171			=head1 NAME
172
173			pmakewhatis - generate a manual database for sman
174
175			=head1 SYNOPSIS
176
177			B<smakewhatis>
178			[B<-database> I<database name>]
179			[B<-dir> I<database directory>]
180			[B<-table> I<name>]
181			[B<-remove>]
182			[I<mandir> ...]
183
184			=head1 DESCRIPTION
185
186			B<Pmakewhatis> generates/updates databases for B<sman>(1). If
187			I<mandir>s are specified, these are used. Otherwise directories in
188			C<@INC> are indexed.
189
190			=head2 OPTIONS
191
192			=over 10
193
194			=item B<-database> I<database name>
195
196			Change the default database name to I<database name>.
197
198			=item B<-dir> I<database directory>
199
200			Change the default database directory to I<database directory>.
201
202			=item B<-table> I<name>
203
204			Use I<name> instead of C<pod> as table name.
205
206			=item B<-clean>
207
208			Clean B<database> before indexing.
209
210			=item B<-remove>
211
212			Remove the selected directories from the database instead of
213			adding/updating. This works only for the pod files which are unchanged
214			since the indexing.
215
216	dpavlin	109	=back
217
218	ulpfr	10	=head1 SEE ALSO
219
220			L<sman>.
221
222			=head1 AUTHOR
223
224			Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>