#!/usr/bin/perl -w # # Publish static versions of ePerl pages. # # Copyright (c) Patrick W. Bryant, 1998. GPL. # # # # #### history: ################################ # # 12-14-1998 v0.3 -- 1st "public" release. # 12-15-1998 v0.4 -- improved pod. # 12-16-1998 v0.41 -- Fixed "noecho" bug (argh!) ############################################### sub gpl() { print qq( epftp v0.3: a Perl script that processes ePerl files and mirrors their output to a remote server. Copyright 1998 Patrick W. Bryant for Georgia State University College of Arts & Sciences Internet Technology Services. 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 SoftwareFoundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Send bug reports, fixes, enhancements, etc. to daspwb\@queequeg.gsu.edu ); exit; } use Net::FTP; use IO::File; use Getopt::Long; use strict; my $recurse=0; my $verbose=0; my $all=0; my $server=0; my $user=0; my $pw=0; my $filter='ehtml'; my $rext='html'; my $rdir=0; my $help=0; my $proc = GetOptions('R|recursive' => \$recurse, 'v|verbose' => \$verbose, 'help|h' => \&help, 'a|all' => \$all, 's|server=s' => \$server, 'u|user=s' => \$user, 'p|passwd=s' => \$pw, 'f|filter=s' => \$filter, 'e|extension=s' => \$rext, 'r|rdir=s' => \$rdir, 'c|copy' => \&gpl); if (!$proc) { use Pod::Usage; pod2usage(VERBOSE=>0); } sub help() { use Pod::Usage; pod2usage(VERBOSE=>1); } if (!$ARGV[0]){help()} if (!$server) { use Term::ReadKey; print "Server: "; chomp($server = ReadLine 0); } if (!$user) { use Term::ReadKey; print "User: "; chomp($user = ReadLine 0); } if (!$pw) { use Term::ReadKey; print "Pass: "; ReadMode(2); chomp($pw = ReadLine 0); print "\n"; ReadMode(0); } my $ftp = Net::FTP->new($server); $ftp->login($user,$pw) || die "Login failed"; if ($rdir){ $ftp->mkdir($rdir); $ftp->cwd($rdir)|| die print "$rdir doesn't seem to exist on $server.\n"; } my $remote_start_dir = $ftp->pwd(); my $local_start_dir = ""; my $dir_head; foreach (@ARGV) { if (!/^\//) { $local_start_dir = $ENV{PWD} . "/"; $remote_start_dir .= "/"; (my $dir_head = $_) =~ s/.*\/(.*)?$/$1/; } if (-d) { handle_dir($local_start_dir . $_, $remote_start_dir . $dir_head); }else {handle_file($local_start_dir . $_, $remote_start_dir)} } sub handle_dir() { my $local=$_[0]; my $remote=$_[1]; if ($verbose){print "$local -> $server:$remote\n"} opendir (DIR, $local) || die "huh? $!"; $ftp->mkdir($remote,1) || die "can't make $remote on $server\n"; my @subdirs; my @plainfiles; my @all_files = grep !/^\.\.?$/, readdir DIR; foreach(@all_files) { if (-d $local . "/" . $_) { push @subdirs, $_; } elsif (/\.$filter$/) { handle_file($local . "/" . $_, $remote); } else { if (($all) && (! /\~$/)) ## Second test (above) ignores emacs backup files. { $ftp->put($local . "/" . $_, $remote . "/" . $_)|| die "$!"; if ($verbose){print "$local/$_ -> $server:$remote/$_\n"} } } } if ($recurse) { foreach (@subdirs) { handle_dir($local . "/" .$_, $remote . "/" . $_); } } } sub handle_file() { my $local = $_[0]; (my $file = $local) =~ s/.*\/(.*)?$/$1/; (my $new_name = $file) =~ s/\.$filter$/\.$rext/; my $remote = $_[1] . "/" . $new_name; my $fh = new IO::File "eperl $local |" || die "$!"; $ftp->put($fh, $remote)|| die "$!"; if ($verbose) { print "local:$file -> $server:$remote\n"; } } $ftp->quit; __END__ =head1 NAME epftp - a script for publishing static versions of dynamic Web pages containing ePerl =head1 DESCRIPTION B uploads files or directories using ftp, but if it encounters a file bristled with ePerl it processes it and uploads the result instead of the original file. =head1 NOTE If you don't have B, you don't need this script. Go to C to find out what you're missing. =head1 AUTHOR Patrick W. Bryant C =head1 PREREQUISITES Must have (duh) C, plus C, C, C, C, C, and LBNL, C if you wanna use this. =pod SCRIPT CATEGORIES CPAN/Misc. =head1 SYNOPSIS B =head1 OPTIONS =over 2 =item B<--recursive, -R> Descend any subdirs encountered =item B<--all, -a> Mirror all files in a directory, not just eperl =item B<--copy, -c> print Copyright stuff (GPL) =item B<--extension, -e pattern> save filtered eperl files with extension "pattern" on the remote server. =item B<--filter, -f pattern> assume files with extension "pattern" are eperl (defaults to "ehtml") =item B<--help, -h> Displays help message =item B<--passwd, -p password> use "password" on remote server =item B<--rdir, -r directory> cwd to "directory" on remote =item B<--server, -s servername> Mirror files to "servername" =item B<--user, -u username> Login as "username" =item B<--verbose, -v> Be verbose =cut