cvs-head/script/index-html.PL

#                              -*- Mode: Perl -*- 
use Config;
use File::Basename qw(&basename &dirname);

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
        if ($^O eq 'VMS' or $^O eq 'os2');  # "case-forgiving"

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{'startperl'} -w
!GROK!THIS!
print OUT <<'!NO!SUBS!';
!NO!SUBS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';
eval 'exec perl -w -S $0 "$@"'
    if 0;

use strict;


use FileHandle;
use Getopt::Long;

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


my %OPT = (database => 'DB',
           dir      => $WAIT::Config->{WAIT_home} || '/tmp',
           table    => 'kbox',
           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}") {
  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}";
  };
  exit;
}
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::HTML;
my $stem = [{
             'prefix'    => ['isotr', 'isolc'],
             'intervall' => ['isotr', 'isolc'],
            },'decode_entities', 'isotr', 'isolc', 'split2', 'stop', 'Stem'];
my $text = [{
             'prefix'    => ['isotr', 'isolc'],
             'intervall' => ['isotr', 'isolc'],
            },
             'decode_entities', 'isotr', 'isolc', 'split2', 'stop'];
my $sound = ['decode_entities', 'isotr', 'isolc', 'split2', 'Soundex'];

my %D;

my $access = tie (%D, 'WAIT::Document::Find',  sub { $_[0] =~ /\.htm/; }, 
                  "/usr/local/etc/httpd/htdocs/berlin");
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 =>
   [
    'text'         => $stem,
    'title'        => $stem,
    'title'        => $text,
   ]
  );
die unless $tb;

my @DIRS;
if (@ARGV) {
  @DIRS = @ARGV;
} else {
  @DIRS  = @{$WAIT::Config->{manpath}};
}

while (my ($path, $content) = each %D) {
  &index($path, $content);
}
$db->close();
exit;

my $NO;
sub index {
  my ($did, $value) = @_;
  if ($tb->have('docid' => $did)) {
    if (!$OPT{remove}) {
      print "duplicate\n";
      return;
    }
  } elsif ($OPT{remove}) {
    print "missing\n";
    return;
  }

  if (-s $did < 100) {
    print "too small\n";
    return;
  }

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


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

=head1 NAME

smakewhatis - 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<Smakewhatis> generates/updates databases for B<sman>(1). If
I<mandir>s are specified, these are used. Otherwise the confiigured
default directories 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<man> 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 manuals which are unchanged
since the indexing.

=head1 SEE ALSO

L<sman>.

=head1 AUTHOR

Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
!NO!SUBS!

close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
1	ulpfr	10	# -- Mode: Perl --
2			use Config;
3			use File::Basename qw(&basename &dirname);
4
5			# List explicitly here the variables you want Configure to
6			# generate. Metaconfig only looks for shell variables, so you
7			# have to mention them as if they were shell variables, not
8			# %Config entries. Thus you write
9			# $startperl
10			# to ensure Configure will look for $Config{startperl}.
11
12			# This forces PL files to create target in same directory as PL file.
13			# This is so that make depend always knows where to find PL derivatives.
14			chdir(dirname($0));
15			($file = basename($0)) =~ s/\.PL$//;
16			$file =~ s/\.pl$//
17			if ($^O eq 'VMS' or $^O eq 'os2'); # "case-forgiving"
18
19			open OUT,">$file" or die "Can't create $file: $!";
20
21			print "Extracting $file (with variable substitutions)\n";
22
23			# In this section, perl variables will be expanded during extraction.
24			# You can use $Config{...} to use Configure variables.
25
26			print OUT <<"!GROK!THIS!";
27			$Config{'startperl'} -w
28			!GROK!THIS!
29			print OUT <<'!NO!SUBS!';
30			!NO!SUBS!
31
32			# In the following, perl variables are not expanded during extraction.
33
34			print OUT <<'!NO!SUBS!';
35			eval 'exec perl -w -S $0 "$@"'
36			if 0;
37
38			use strict;
39
40
41			use FileHandle;
42			use Getopt::Long;
43
44			require WAIT::Database;
45			require WAIT::Config;
46			require WAIT::Parse::HTML;
47			require WAIT::Document::Find;
48
49
50			my %OPT = (database => 'DB',
51			dir => $WAIT::Config->{WAIT_home} \|\| '/tmp',
52			table => 'kbox',
53			clean => 0,
54			remove => 0,
55			);
56
57			GetOptions(\%OPT,
58			'database=s',
59			'dir=s',
60			'table=s',
61			'clean!',
62			'remove',
63			) \|\| die "Usage: ...\n";
64
65			my $db;
66			if ($OPT{clean} and -d "$OPT{dir}/$OPT{database}") {
67			eval {
68			my $tmp = WAIT::Database->open(name => $OPT{database},
69			'directory' => $OPT{dir})
70			or die "Could not open table $OPT{table}: $@";
71			my $tbl = $tmp->table(name => $OPT{table});
72			$tbl->drop if $tbl;
73			$tmp->close;
74			rmtree("$OPT{dir}/$OPT{database}/$OPT{table}",1,1)
75			if -d "$OPT{dir}/$OPT{database}/$OPT{table}";
76			};
77			exit;
78			}
79			unless (-d "$OPT{dir}/$OPT{database}") {
80			$db = WAIT::Database->create(name => $OPT{database},
81			'directory' => $OPT{dir})
82			or die "Could not open database $OPT{database}: $@";
83			} else {
84			$db = WAIT::Database->open(name => $OPT{database},
85			'directory' => $OPT{dir})
86			or die "Could not open table $OPT{table}: $@";
87			}
88
89			my $layout= new WAIT::Parse::HTML;
90			my $stem = [{
91			'prefix' => ['isotr', 'isolc'],
92			'intervall' => ['isotr', 'isolc'],
93			},'decode_entities', 'isotr', 'isolc', 'split2', 'stop', 'Stem'];
94			my $text = [{
95			'prefix' => ['isotr', 'isolc'],
96			'intervall' => ['isotr', 'isolc'],
97			},
98			'decode_entities', 'isotr', 'isolc', 'split2', 'stop'];
99			my $sound = ['decode_entities', 'isotr', 'isolc', 'split2', 'Soundex'];
100
101			my %D;
102
103			my $access = tie (%D, 'WAIT::Document::Find', sub { $_[0] =~ /\.htm/; },
104			"/usr/local/etc/httpd/htdocs/berlin");
105			die $@ unless defined $access;
106
107
108			my $tb = $db->table(name => $OPT{table}) \|\|
109			$db->create_table
110			(name => $OPT{table},
111			attr => ['docid', 'headline', 'size'],
112			keyset => [['docid']],
113			layout => $layout,
114			access => $access,
115			invindex =>
116			[
117			'text' => $stem,
118			'title' => $stem,
119			'title' => $text,
120			]
121			);
122			die unless $tb;
123
124			my @DIRS;
125			if (@ARGV) {
126			@DIRS = @ARGV;
127			} else {
128			@DIRS = @{$WAIT::Config->{manpath}};
129			}
130
131			while (my ($path, $content) = each %D) {
132			&index($path, $content);
133			}
134			$db->close();
135			exit;
136
137			my $NO;
138			sub index {
139			my ($did, $value) = @_;
140			if ($tb->have('docid' => $did)) {
141			if (!$OPT{remove}) {
142			print "duplicate\n";
143			return;
144			}
145			} elsif ($OPT{remove}) {
146			print "missing\n";
147			return;
148			}
149
150			if (-s $did < 100) {
151			print "too small\n";
152			return;
153			}
154
155			unless (defined $value) {
156			print "unavailable\n";
157			return;
158			}
159			printf STDERR "ok [%d]\n", ++$NO;
160
161			my $record = $layout->split($value);
162			$record->{size} = length($value);
163			my $headline = $record->{title} \|\| $did;
164			$headline =~ s/\s+/ /g; $headline =~ s/^\s+//;
165			printf "%s\n", substr($headline,0,80);
166			if ($OPT{remove}) {
167			$tb->delete('docid' => $did, headline => $headline, %{$record});
168			} else {
169			$tb->insert('docid' => $did, headline => $headline, %{$record});
170			}
171			}
172
173
174			__END__
175			## ###################################################################
176			## pod
177			## ###################################################################
178
179			=head1 NAME
180
181			smakewhatis - generate a manual database for sman
182
183			=head1 SYNOPSIS
184
185			B<smakewhatis>
186			[B<-database> I<database name>]
187			[B<-dir> I<database directory>]
188			[B<-table> I<name>]
189			[B<-remove>]
190			[I<mandir> ...]
191
192			=head1 DESCRIPTION
193
194			B<Smakewhatis> generates/updates databases for B<sman>(1). If
195			I<mandir>s are specified, these are used. Otherwise the confiigured
196			default directories are indexed.
197
198			=head2 OPTIONS
199
200			=over 10
201
202			=item B<-database> I<database name>
203
204			Change the default database name to I<database name>.
205
206			=item B<-dir> I<database directory>
207
208			Change the default database directory to I<database directory>.
209
210			=item B<-table> I<name>
211
212			Use I<name> instead of C<man> as table name.
213
214			=item B<-clean>
215
216			Clean B<database> before indexing.
217
218			=item B<-remove>
219
220			Remove the selected directories from the database instead of
221			adding/updating. This works only for the manuals which are unchanged
222			since the indexing.
223
224			=head1 SEE ALSO
225
226			L<sman>.
227
228			=head1 AUTHOR
229
230			Ulrich Pfeifer E<lt>F<pfeifer@ls6.informatik.uni-dortmund.de>E<gt>
231			!NO!SUBS!
232
233			close OUT or die "Can't close $file: $!";
234			chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
235			exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';