Checking filenames?

[Jas]

I am not sure how to get this the last part of this to work properly.  I 
am trying to check for any file with this format [20040301-www.tar.gz] 
and remove any past 30 days.  Pointers appreciated as this is only my 
second script ever written in perl (besides the 'hello world'). =)
Thanks in advance,
jas

#!/usr/bin/perl

# Modules to use
use strict;
use warnings;
use POSIX qw(strftime);
use Archive::Tar;
use Compress::Zlib;
use File::Find;
use Net::FTP;
# Current date stamp
my $date = strftime('%Y%m%d', localtime());
# Create tarball from /path/to/www/ directory
my @files;
   find(sub { push @files,$File::Find::name },"/path/to/www/");
   Archive::Tar->create_archive("www.tar",0,@files);
# Create Archive from recently created tarball
my $gz = system('gzip -9 www.tar');
   $gz = system('mv -f www.tar.gz ' . $date . '-www.tar.gz');
# Remove outdated archives from ftp.serv
my $ftp = Net::FTP->new("ftp.serv", Debug => 1)or die "Could not open 
Connection to ftp.serv";
   $ftp->login("login", 'password')or die "Could not login to ftp.serv: 
$@";

# Upload all archives in /path/to/backups/ directory
foreach my $bup (glob('/path/to/backups/*-www.tar.gz')) {
    $ftp->put($bup) or die "Could not transfer files ", $ftp->message; }
# Begin search for archives older than 30 days on server
my @alst = $ftp->ls;
my $tdy = (30 * 24 * 60 * 60);
my $tme = localtime();
my @list;
   foreach my $file(@alst) {
    if($file =~ /^(\d{8})-www\.tar\.gz$/) {
     my $fdte = $1;
     my $fyyyy = substr($fdte, 0, 4);
     my $fmm = substr($fdte, 4, 2);
     my $fdd = substr($fdte, 6, 2);
     my $ftme = $fdd, $fmm, $fyyyy;
     if($fdte < $date) {
      push @list, $file;
     } else {
      warn "Skipping recent file: $file"; }
     } else {
      warn "Skipping improper file format: $file"; }
     }
     foreach my $file(@list) {
      $ftp->delete($file)or warn "Cannot delete remote file ($file): " 
. $ftp->message; }

$ftp->quit;

--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>