[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Sheflug] shell script challenge



On 2003.07.24 17:46, Dave Mitchell wrote:
> >is Perl allowed?
> Yeah, if you think it's a better solution

Perl is generally best for this sort of thing.

below is a rough attmpt with some rudimentary error checking.
Dave, thanks for the code, my only objection to perl, is that as I've never been forced to use it, I still find it rather impenetrable. It works pretty much as I hoped it would, except the date on the archive seems to be wrong. It seems to be using the current month. So if I run it 1st August the current month will be August but the month to be archived will be June. This also creates a problem with the year at change over. I've had a bash at fixing it, but this is the first perl I've ever written, so do you think my changes were wise?

Simon
#!/usr/bin/perl

use strict;
use warnings;

my $base_dir = '/home/simon/testmail2';
my $list_dir = "$base_dir/lists";
my $last_dir = "$base_dir/lastmonth";
my $archive_dir = "$base_dir/archive";


my @months = qw(janurary February March April May June July August
	September October November December);


my ($month, $year) = (localtime)[4,5];
$year += 1900;
my $cur_month = $month;
$month = ($month + 10) % 12;
if ($cur_month < $month) {
    $year -= 1;
}
$month = $months[$month];

my $archive_subdir = "$archive_dir/$year/$month";

opendir D, "$last_dir" or die "can't open $last_dir: $!\n";
my @files = grep /\@/, readdir(D);

if (@files) {
    mysys("mkdir -p $archive_subdir") unless -d $archive_subdir;
    foreach my $file ( [at] files) {
	my $afile = "$archive_subdir/$file";
	if (-f $afile) {
	    warn "$afile already exists!\n";
	    next;
	}
	mysys("mv $last_dir/$file $afile; gzip $afile");
    }
}

opendir D, "$list_dir" or die "can't open $list_dir: $!\n";
@files = grep /\@/, readdir(D);

foreach my $file ( [at] files) {
    my $lfile = "$last_dir/$file";
    if (-f $lfile) {
	warn "$lfile already exists!\n";
	next;
    }
    mysys("mv $list_dir/$file $lfile");
}


sub mysys {
    print " [at] _\n";
    ## XXX uncomment next line to make it actually work
    system  [at] _;
}