#! %%PERL%% ## # SWISH++ # httpindex # # Copyright (C) 1998 Paul J. Lucas # # 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. ## ########## You shouldn't have to change anything below this line. ############# require 5.003; use File::Basename; use File::Path; use FileHandle; use Getopt::Std; use IPC::Open2; use lib '%%I_LIB%%'; require WWW; $me = basename( $0 ); # options from index(1) we accept $index_opts = 'Ac:C:e:E:f:F:g:h:i:m:M:p:s:t:T:W:'; getopts( "${index_opts}dDv:" ) or die "$me: error in command-line options\n"; die "$me: -d and -D are mutually exclusive\n" if $opt_d && $opt_D; ## # We have to reconstruct a set of options and their arguments from the options # actually specified. ## for ( split( /:/, $index_opts ) ) { my $v = eval "\$opt_$_"; push( @index_opts, "-$_$v" ) if $v; } open2( \*INDEX_STDOUT, \*INDEX_STDIN, "%%I_BIN%%/index @index_opts -v4 -" ); while ( <> ) { next unless /-> "([^"]+)"/; my $path = $1; # Got a file from wget: give it to index(1) print INDEX_STDIN "$path\n"; # Record the name of the top-level directory (once). ( $dir = $path ) =~ s!/.+!! unless $dir; # Wait for index(1) to index the file by doing a blocking read. Skip # blank lines and informational lines from index(1) about generating # partial indicies. do { $_ = ; } while ( /^$|partial/ ); if ( $opt_d ) { my $desc = WWW::extract_description( $path ); if ( $desc ) { if ( open( FILE, ">$path" ) ) { print FILE "$desc\n"; close FILE; } else { warn "$me: can not overwrite $path\n"; } } else { unlink( $path ); } } elsif ( $opt_D ) { unlink( $path ); } if ( $opt_v < 4 ) { next if /\(skipped:/; if ( $opt_v < 3 ) { next if /^ /; next if $opt_v < 2; } } print; } close INDEX_STDIN; ## # We must actually read the remaining output from index(1) regardless of # whether we print it otherwise index(1) might block. ## while ( ) { print if $opt_v; } rmtree( $dir ) if $opt_D; # remove (empty) directory tree