#!/opt/perl-5.004/bin/perl -w # # $Id: maketreedb.pl,v 1.2 1997/06/20 08:17:56 gnats Exp $ # # # DESCRIPTION: maketreedb.pl - index documents for the virtual searchtree # # URL: none yet # # AUTHOR: Cord Beermann (cord@Wunder-Nett.org) # # Thanks to: Ralf Begemann (begemann@cc.fh-lippe.de) # Gerold Meerkoetter (gerold@noc.fh-lippe.de) # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # # # A Perl script is "correct" if it gets the job done before your boss fires # you. # ('Programming Perl Second Edition' by Larry Wall, Tom Christiansen # & Randal. L. Schwartz) # # Bugs and shortcomings # none yet # # Todo # * write instructions # ### Configuration ### # $WEBROOT="/var/infosystems/www/webroot"; $DBROOT="/fhl/dvz/loesungen"; $FILE_TITLE_DB="$WEBROOT$DBROOT/.file_title.db"; $KW_FILE_DB="$WEBROOT$DBROOT/.kw_file.db"; $FILE_KW_DB="$WEBROOT$DBROOT/.file_kw.db"; # ### End of Configuration ### # Initialize Variables use vars qw ! $WEBROOT $DBROOT $DESTFILE %kwdb %fdb ! ; # include perl-modules use POSIX; use GDBM_File; # open the db-files # kwfiledb: kw --> file tie %kw_file_db, 'GDBM_File', $KW_FILE_DB, O_CREAT|O_RDWR, 0644; undef(%kw_file_db); # filekwdb: file --> kw tie %file_kw_db, GDBM_File, $FILE_KW_DB, O_CREAT|O_RDWR, 0644; undef(%file_kw_db); # fdb: file --> title tie %file_title_db, GDBM_File, $FILE_TITLE_DB, O_CREAT|O_RDWR, 0644; undef(%file_title_db); # Loop for each file foreach $file (<$WEBROOT$DBROOT/*/*.html>) { my(@keywords, $kw); open (FILE, "$file") || warn("open $file: $!"); LOOP: while (defined($content = )) { # store all after -Tag if ($content =~ s#.*\##i) { # if is in the same line, exit LOOP if ($content =~ s#\.*##i) { last LOOP; } else { # read next line while ($content .= ) { # if is in it, exit LOOP if ($content =~ s#\.*##i) { last LOOP; } } } } } # strip trailing, tailing and double spaces, LineFeeds . $content =~ s/\s+/ /g; $content =~ s/(^\s+|\s+$)//; $title = $content; # if there is no title, print a warning unless ($title =~ s#.*\([^\>\<]+)\.*#$1#i) { warn("$file: no title found\n"); next; } # if there are no keywords, print a warning # else throw all away except for the keywords unless ($content =~ m#.*\.*#i) { warn("$file: no keywords found\n"); next; } # load array with keywords @keywords = split(/\s*,\s*/, $1); $file =~ s#$WEBROOT$DBROOT/##; # Filenames with embedded spaces won't work, print a warning if($file =~ m/ /) { warn("Space in filename \"$file\" - skipped"); next; } # Loop for each keyword foreach $kw (@keywords) { # if(defined($kw_file_db{$kw}) and $kw_file_db{$kw} !~ /\b$kw\b/) { # warn(length($kw_file_db{$kw})+length($file)+length($kw)); if(defined($kw_file_db{$kw})) { $kw_file_db{$kw} .= " $file"; } else { $kw_file_db{$kw} = $file; } if(defined($file_kw_db{$file}) and $file_kw_db{$file} !~ /\b$file\b/) { $file_kw_db{$file} .= " $kw"; } else { $file_kw_db{$file} = $kw; } } $file_title_db{$file} = $title; } # close files untie(%kw_file_db); untie(%file_title_db); untie(%file_kw_db);