@rem = '-*- Perl -*-'; @rem = ' @echo off f:\perl\bin\perl f:/users/tom/web-page/upload.cmd %1 %2 %3 %4 %5 %6 %7 %8 %9 goto endofperl '; # perl script to upload web page directory into the worldnet PWP upload # area. # # also automatically updates the whats-new.html page prior to uploads. # # attempts to faithfully re-create the directory structure on the local PC # onto the upload server. # # prompts for the FTP password if not built in. use strict; use Net::FTP; use vars qw($localdir $username $password $newgif); $newgif = "new2.gif"; # name of image file to mark new files with $localdir = "."; # say where to find local copy of web page directory $username = "Tom.Horsley"; # replace this with your user name #$password = "whatever"; # if you don't care about security fill in this also use vars qw(@dirlist @filelist @allfiles %prev); chdir($localdir) || die "Unable to cd to $localdir\n"; # gather_names is a recursive routine to traverse the local directory and # build a few data structures: # # @dirlist - ordered list of all sub-directory names # @filelist - ordered list of files new since last upload # @allfiles - ordered list of all files in directory tree # sub gather_names { my $dir = shift; my @files; my $d; my $f; my $prefix; my $lastime = ((stat("whats-new.html"))[9]); if (! defined($lastime)) { $lastime = 0; } if (defined($dir)) { $d = $dir; push(@dirlist, $dir); $prefix = "$d/"; } else { $d = "."; $prefix = ''; } opendir(DIR, $d) || die "Cannot read directory $d\n"; @files = readdir(DIR); closedir(DIR); foreach $f (sort(@files)) { next if (($f eq '.') || ($f eq '..') || ($f=~/^_/)); if (-d "${prefix}$f") { gather_names("${prefix}$f"); } else { push(@allfiles, "${prefix}$f"); if (((stat("${prefix}$f"))[9]) > $lastime) { push(@filelist, "${prefix}$f"); } } } } # get_last_info runs gather_names then reads the _lastdir file to get the # list of names uploaded last time and stick it in the %prev hash. It then # updates the _lastdir file with the list of files from @allfiles so it can # get the right info the next time it runs. # # Any files not named in %prev are new since the last upload, and marked as # such in the generated whats-new.html file. # sub get_last_info { local $_; if (open(LAST, "<_lastdir")) { while () { chomp; $prev{$_} = 1; } close(LAST); } open(LAST, ">_lastdir") || die "Cannot write _lastdir file\n"; foreach $_ (@allfiles) { print LAST "$_\n"; } close(LAST); } # write_whats_new generates a whats-new.html file showing changed files # since the last upload, and marking brand new files with the magical new # gif. files ending with .gif and .jpg are ignored. files ending with .htm # or .html are searched for information to display as part of the # link created. # sub write_whats_new { # Nothing to do here if no new files... my @newlist; my $f; my $title; local $_; foreach $f (@filelist) { next if (($f=~/\.gif$/i) || ($f=~/\.jpg$/i)); push(@newlist, $f); } if (scalar(@newlist) > 0) { open(WHATNEW, ">whats-new.html") || die "Cannot write whats-new.html\n"; print WHATNEW "<html> <title>What's New

What's New

The following files were new or changed the last time these web pages were updated:

"; if ($f=~/\.html?$/i) { if (open(WEB, "<$f")) { while () { last if (/\/); if (/\(.+)\<\/title\>/i) { $title = $1; last; } } close(WEB); } } $title=~s/^\s+//; $title=~s/\s+$//; print WHATNEW "$title"; if (! defined($prev{$f})) { print WHATNEW " "; } print WHATNEW " updated $when"; print WHATNEW "

\n This page last updated "; print WHATNEW scalar(localtime); print WHATNEW "\n"; print WHATNEW "

\n"; close(WHATNEW); push(@filelist, "whats-new.html"); } } # update_web_page does all the work. It calls the other routines # and FTPs the changed files up to the upload server. # sub update_web_page { gather_names; get_last_info; write_whats_new; if (scalar(@filelist) > 0) { if (! defined($password)) { print STDERR "I need your security word as a password: "; $password=; chomp($password); } print STDERR "Connecting to upload.att.net...\n"; my $ftp = Net::FTP->new("upload.att.net") || die "Cannot connect to upload.att.net\n"; print STDERR "$username logging in to upload.att.net...\n"; $ftp->login($username, $password) || die "Cannot login to upload.att.net (check username and password)\n"; # First make sure all directories are created (if these fail, I # pay no attention - I just assume its because they already exist). my $t; foreach $t (@dirlist) { $ftp->mkdir($t, 1); } # Now upload all the changed files $ftp->binary; foreach $t (@filelist) { print STDERR "Uploading $t...\n"; $ftp->put($t, $t) || die "Failed to upload $t\n"; } # We are done print STDERR "Update complete, dropping FTP connection...\n"; $ftp->quit; } else { print STDERR "Everything already appears to be up to date.\n"; } } update_web_page; __END__ :endofperl