Regular backup/snapshots

Question

A (long) while ago I set up a file server in my basement running Linux. I am OCD when it comes to backups.

I set the server up with (remember, this was a while ago):

• disk for OS
• disk for 'valuable' things
• disk for backups

The idea was that if any one disk failed, I could replace things with minimal loss. The OS was supposed to be stuff that was easy to reinstall. The 'valuable' things are data that is irreplaceable (e-mail, photos, documents, etc.). The backup disk contains a copy of the valuable data.

I also have learned (a long time ago) that keeping backups of your current data is not very useful if you corrupt (or delete) your current data, and then replace your backups with the corrupt version. As a result, I keep 'snapshots' of my valuable data at regular intervals, and I can go back to any snapshot to retrieve the data as it was at the time of the snapshot. If I delete a file now, I can go to a previous snapshot, and restore it.

I started using a script written in bash to do this for me.... Mike's handy backup script!

This worked for a while, but I discovered it had problems:

1. I wanted to make it configurable (specify the folders to back up outside the script)
2. sometimes the backup was long-running, and another backup could start before the previous one completed (these snapshots are taken at every hour).
3. My monthly backup routine copies the entire snapshot disk to an external drive, and this takes hours, and I want the data to be consistent
4. rm -rf on deeply-hard-linked files is a slow process.... so I had to remove it from the script....

I extended Mike's script, and then ended up rewriting it in perl.

Over time things have changed. I now have a RAID array mounted on /valuable which contains things that are supposedly 'valuable' to me. The regular filesystem is still mounted as /. The destination for these snapshots is the disk (also a RAID array) mounted at /snapshotng. There is about 2TB of valuable data (many large photographs from the whole family, e-mails from decades, and documents, etc.)

An example configuration file for the script is:

# Try to make things in revers alphabetic order...
# makes co-existence with the snashot2backup more friendly.
# but still put the smaller folders first

# smaller folders
versioncontrol  /valuable/versioncontrol  .versioncontrol_exclude
local           /usr/local                .local_exclude
mysql           /valuable/mysqlbackups    .mysql_exclude
www             /valuable/www             .www_exclude
etc             /etc                      .etc_exclude # get the /etc folder

# medium folders
root            /root                     .root_exclude
opt             /opt                      .opt_exclude

# large folders
gallery_cache   /valuable/gallery23_cache .gallery_cache_exclude
netshare        /valuable/netshare        .netshare_exclude
pictures        /valuable/pictures        .pictures_exclude
home            /valuable/home            .home_exclude
webdav          /valuable/webdav          .webdav_exclude

The key features of this script are:

• it runs every hour (cron job)
• it creates a complete copy of the source directory in a specially named folder in /snapshotng
• the snapshot uses hard-linked copies of the files unless the files have been changed since the previous snapshot (the hard-link is to the previous snapshot, not to the source).
• it marks 'old' copies as 'trash'. It keeps at least:
  • 1 copy from every year for the past 10 years
  • 1 copy from every month for the past 18 months
  • 1 copy from every week for the past 16 weeks
  • 1 copy from every day for the past 14 days
  • 1 copy from every hour for the past 48 hours.
• anything that does not fit the above 'keep' list is marked as trash.
• it creates a file-system lock on each (target) directory it is about to back up
• it e-mails me if there is a problem (mostly by logging to the cron job output)

This script has been in use now for close on 10 years.... it has been extended, modified, and 'fixed', but has never been reviewed. Because of its age, it does not use the latest perl goodies..... sorry.

The output from the program looks like the following:

==============================
Mon Feb 17 20:17:01 EST 2014
------------------------------
Attempting to obtain lock /snapshotng/.snap.lock
Running "lockfile" "-5" "-r12" "/snapshotng/.snap.lock"
Locked snapshot folder with /snapshotng/.snap.lock in 0 seconds
SNAPSHOT PROCESS BEGINNING. Using ID 2014.02.17.20.17 @ Mon Feb 17 20:17:01 2014
Processing 13 folders based on the configuration file



Snapshot versioncontrol:  /valuable/versioncontrol @ Mon Feb 17 20:17:01 2014
Running "lockfile" "-5" "-r-1" "/snapshotng/versioncontrol/.snapshot.lock"
Locked snapshot folder with /snapshotng/versioncontrol/.snapshot.lock in 0 seconds
Rules:
  ^versioncontrol\.2005\..*$
  ^versioncontrol\.2006\..*$
  ^versioncontrol\.2007\..*$
  ^versioncontrol\.2008\..*$
  ^versioncontrol\.2009\..*$
  ....
  ^versioncontrol\.2014\.02\.17\.17\..*$
  ^versioncontrol\.2014\.02\.17\.18\..*$
  ^versioncontrol\.2014\.02\.17\.19\..*$
  ^versioncontrol\.2014\.02\.17\.20\..*$
Matched versioncontrol.2009.05.01.06.55 to rule ^versioncontrol\.2009\..*$
Matched versioncontrol.2010.01.01.00.05 to rule ^versioncontrol\.2010\..*$
Matched versioncontrol.2011.01.01.00.17 to rule ^versioncontrol\.2011\..*$
.....
Matched versioncontrol.2014.02.17.13.17 to rule ^versioncontrol\.2014\.02\.17\.13\..*$
Matched versioncontrol.2014.02.17.14.17 to rule ^versioncontrol\.2014\.02\.17\.14\..*$
Matched versioncontrol.2014.02.17.15.17 to rule ^versioncontrol\.2014\.02\.17\.15\..*$
Matched versioncontrol.2014.02.17.16.17 to rule ^versioncontrol\.2014\.02\.17\.16\..*$
Matched versioncontrol.2014.02.17.17.17 to rule ^versioncontrol\.2014\.02\.17\.17\..*$
Matched versioncontrol.2014.02.17.18.17 to rule ^versioncontrol\.2014\.02\.17\.18\..*$
Matched versioncontrol.2014.02.17.19.17 to rule ^versioncontrol\.2014\.02\.17\.19\..*$
Latest is versioncontrol.2014.02.17.19.17
Running "mv" "/snapshotng/versioncontrol/versioncontrol.2014.02.15.20.17"  "/snapshotng/versioncontrol/trash.versioncontrol.2014.02.15.20.17"
Using previous snapshot /snapshotng/versioncontrol/versioncontrol.2014.02.17.19.17 as the baseline.
Running "cp" "-alH" "/snapshotng/versioncontrol/versioncontrol.2014.02.17.19.17" "/snapshotng/versioncontrol/tmpsnap"
****  Using Exclude file /snapshotng/versioncontrol/.versioncontrol_exclude ****
Running "rsync" "-v" "-a" "--delete" "--exclude-from=/snapshotng/versioncontrol/.versioncontrol_exclude" "--delete-excluded" "/valuable/versioncontrol/" "/snapshotng/versioncontrol/tmpsnap/"
sending incremental file list

sent 75376 bytes  received 607 bytes  151966.00 bytes/sec
total size is 183823276  speedup is 2419.27
Running "mv" "/snapshotng/versioncontrol/tmpsnap" "/snapshotng/versioncontrol/versioncontrol.2014.02.17.20.17"
Running "rm" "-f" "/snapshotng/versioncontrol/.snapshot.lock"
Completed snapshot for /valuable/versioncontrol in to /snapshotng/versioncontrol/versioncontrol.2014.02.17.20.17 @ Mon Feb 17 20:17:02 2014

......


SNAPSHOT PROCESS COMPLETE. Using ID 2014.02.17.20.17 @ Mon Feb 17
20:19:23 2014Mon Feb 17 20:19:23 2014 in 2 minutes, 22 seconds

The actual example folder for the 'versioncontrol' backup looks like:

trash.versioncontrol.2014.02.15.08.17  versioncontrol.2009.05.01.06.55  versioncontrol.2013.05.01.00.17  versioncontrol.2013.12.08.00.18  versioncontrol.2014.02.05.00.17  versioncontrol.2014.02.15.22.17  versioncontrol.2014.02.16.11.17  versioncontrol.2014.02.17.00.17  versioncontrol.2014.02.17.13.17
trash.versioncontrol.2014.02.15.09.17  versioncontrol.2010.01.01.00.05  versioncontrol.2013.06.01.00.17  versioncontrol.2013.12.15.00.18  versioncontrol.2014.02.06.00.17  versioncontrol.2014.02.15.23.17  versioncontrol.2014.02.16.12.17  versioncontrol.2014.02.17.01.17  versioncontrol.2014.02.17.14.17
trash.versioncontrol.2014.02.15.10.17  versioncontrol.2011.01.01.00.17  versioncontrol.2013.07.01.00.17  versioncontrol.2013.12.22.00.18  versioncontrol.2014.02.07.00.17  versioncontrol.2014.02.16.00.17  versioncontrol.2014.02.16.13.17  versioncontrol.2014.02.17.02.17  versioncontrol.2014.02.17.15.17
trash.versioncontrol.2014.02.15.11.17  versioncontrol.2012.01.01.00.17  versioncontrol.2013.08.01.00.17  versioncontrol.2013.12.29.00.17  versioncontrol.2014.02.08.00.17  versioncontrol.2014.02.16.01.17  versioncontrol.2014.02.16.14.17  versioncontrol.2014.02.17.03.17  versioncontrol.2014.02.17.16.17
trash.versioncontrol.2014.02.15.12.17  versioncontrol.2012.09.01.00.17  versioncontrol.2013.09.01.00.17  versioncontrol.2014.01.01.00.17  versioncontrol.2014.02.09.00.17  versioncontrol.2014.02.16.02.17  versioncontrol.2014.02.16.15.17  versioncontrol.2014.02.17.04.17  versioncontrol.2014.02.17.17.17
trash.versioncontrol.2014.02.15.13.17  versioncontrol.2012.10.07.20.17  versioncontrol.2013.10.01.00.17  versioncontrol.2014.01.01.01.17  versioncontrol.2014.02.09.01.17  versioncontrol.2014.02.16.03.17  versioncontrol.2014.02.16.16.17  versioncontrol.2014.02.17.05.17  versioncontrol.2014.02.17.18.17
trash.versioncontrol.2014.02.15.14.17  versioncontrol.2012.11.01.00.17  versioncontrol.2013.11.01.00.17  versioncontrol.2014.01.05.00.17  versioncontrol.2014.02.10.00.17  versioncontrol.2014.02.16.04.17  versioncontrol.2014.02.16.17.17  versioncontrol.2014.02.17.06.17  versioncontrol.2014.02.17.19.17
trash.versioncontrol.2014.02.15.15.17  versioncontrol.2012.12.01.00.17  versioncontrol.2013.11.03.00.17  versioncontrol.2014.01.12.00.17  versioncontrol.2014.02.11.00.17  versioncontrol.2014.02.16.05.17  versioncontrol.2014.02.16.18.17  versioncontrol.2014.02.17.07.17  versioncontrol.2014.02.17.20.17
trash.versioncontrol.2014.02.15.16.17  versioncontrol.2013.01.01.00.17  versioncontrol.2013.11.10.00.18  versioncontrol.2014.01.19.00.17  versioncontrol.2014.02.12.00.17  versioncontrol.2014.02.16.06.17  versioncontrol.2014.02.16.19.17  versioncontrol.2014.02.17.08.17
trash.versioncontrol.2014.02.15.17.17  versioncontrol.2013.01.01.01.17  versioncontrol.2013.11.17.00.17  versioncontrol.2014.01.26.00.17  versioncontrol.2014.02.13.00.17  versioncontrol.2014.02.16.07.17  versioncontrol.2014.02.16.20.17  versioncontrol.2014.02.17.09.17
trash.versioncontrol.2014.02.15.18.17  versioncontrol.2013.02.01.00.17  versioncontrol.2013.11.24.00.18  versioncontrol.2014.02.01.00.17  versioncontrol.2014.02.14.00.17  versioncontrol.2014.02.16.08.17  versioncontrol.2014.02.16.21.17  versioncontrol.2014.02.17.10.17
trash.versioncontrol.2014.02.15.19.17  versioncontrol.2013.03.01.00.17  versioncontrol.2013.12.01.00.18  versioncontrol.2014.02.02.00.17  versioncontrol.2014.02.15.00.17  versioncontrol.2014.02.16.09.17  versioncontrol.2014.02.16.22.17  versioncontrol.2014.02.17.11.17
trash.versioncontrol.2014.02.15.20.17  versioncontrol.2013.04.01.00.17  versioncontrol.2013.12.01.01.18  versioncontrol.2014.02.04.00.17  versioncontrol.2014.02.15.21.17  versioncontrol.2014.02.16.10.17  versioncontrol.2014.02.16.23.17  versioncontrol.2014.02.17.12.17

And you can see that an example file has many hard-links (113 in this case):

ls -la versioncontrol.2014.02.17.20.17/cvs/Garage/tx.asm,v 
-r--r--r-- 113 user users 31582 Jun 24  2008 versioncontrol.2014.02.17.20.17/cvs/Garage/tx.asm,v

---

Here's the perl code.... Any improvements, suggestions, criticisms are welcome.

#!/usr/bin/perl -w
# ----------------------------------------------------------------------
# perl version of mikes handy rotating-filesystem-snapshot utility
# ----------------------------------------------------------------------

use strict;

# The following are all used in the 'END' code block... and need to have some value...
my $now        = time();
my $id         = "Not Yet Calculated";
my $snaplock   = "";
my $proglock   = "";
my $rmtmpdir   = "";
my $exitcode   = 1;

sub mysys(;@) {
  my @cl;
  push @cl, @_;
  my $msg = '"' . join ('" "', @cl) . '"';
  print "Running $msg\n";
  system(@cl);
  if ($? == -1) {
    die "failed to execute: $!\n";
  } elsif ($? & 127) {
    die sprintf ("child died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without');
  } elsif ($?) {
    printf STDERR ("child exited with value %d: %s\n", $? >> 8, $msg);
    return 0;
  }
  return 1;
}

my $snapdir    = "/snapshotng";
my $lockfile   = "$snapdir/.snap.lock";
my $keepyears  = 10;
my $keepmonths = 18;
my $keepweeks  = 16;
my $keepdays   = 14;
my $keephours  = 48;

my $configfile = shift @ARGV;
$configfile  ||= "/etc/snapshot/snap.cfg";
-f $configfile or die "Unable to locate config file $configfile";

# Sort out locking... This creates/locks the file, clears it, writes out the process ID.

my $strt = time();
# try to lock the file for a full minute... then fail.
print "Attempting to obtain lock $lockfile\n";
mysys("lockfile", "-5", "-r12", "$lockfile");
$proglock = $lockfile;
print "Locked snapshot folder with $proglock in " . ( time() - $strt ) . " seconds\n";

$now = time();
$id = buildID($now);

print "SNAPSHOT PROCESS BEGINNING. Using ID $id \@ " . localtime() . "\n";

my (%sourcefolders, %excludes, @order);

open CONFIG, "< $configfile" or die "Could not open config file $configfile: $!";
while (<CONFIG>) {
  chomp;
  $_ =~ s/#.*$//; #trim comments
  $_ =~ s/^\s+|\s+$//g; #trim line
  $_ =~ s/\s+/ /g; #normalize whitespace
  next unless m/\w/; #require at least some content
  my @parts = split / /;
  @parts >= 2 or die "Config lines need to be of the form 'name  path [excludefile]'.";
  $sourcefolders{$parts[0]} = $parts[1];
  $excludes{$parts[0]} = "";
  if (@parts == 3) {
    $excludes{$parts[0]} = $parts[2];
  }
  push @order, $parts[0];
}

$exitcode = @order;
print "Processing $exitcode folders based on the configuration file\n\n";
foreach (@order) {
  processSnapshot($_);
  $exitcode--;
}

mysys ("rm", "-f", "$proglock");
$proglock = "";

END {
    if ($proglock) {
      print "\n\nWARNING - INTERRUPTED: Removing lock files and temporary files\n";
      if ($rmtmpdir and -d $rmtmpdir) {
        print "Removing Temporary folder $rmtmpdir (can take a long time). Please let this finish!\n";
        system("rm -rf $rmtmpdir");
        print "Done!\n";
      }
      if ($snaplock && -f $snaplock) {
        print "Removing lock file $snaplock\n";
        system("rm -f $snaplock");
      }
      print "Removing lock file $proglock\n";
      system("rm -f $proglock");
    }
    # truncate(LOCK, 0) or die "Can't truncate lock file to indicate completion: $!";;
    # close (LOCK) or die "Can't close lock file: $!";
    my $secs = time() - $now;
    printf ("SNAPSHOT PROCESS COMPLETE. Using ID %s \@ %s" . localtime() . " in %d minutes, %02d seconds\n", $id, scalar(localtime()), int($secs / 60.0), ($secs % 60));
    if ($exitcode) {
      print "Failed to process successfully... there is an exitcode of $exitcode\n";
      exit $exitcode;
    }
}

exit 0;

### END OF PROGRAM, The following are the implementing subroutines.

sub buildID {
  my $now = shift;
  $now ||= time();
  my @date = localtime($now);
  my $year = $date[5] + 1900;
  my $month = $date[4] + 1;
  my $day = $date[3];
  my $hour = $date[2];
  my $min = $date[1];
  return sprintf ("%04d.%02d.%02d.%02d.%02d", $year, $month, $day, $hour, $min) ;
}

sub lastYears($) {
  my $name = shift;
  my $to = (localtime($now))[5] + 1900;
  my $from = $to - $keepyears + 1;
  my @ret;
  for ($from .. $to) {
    push @ret, sprintf('^%s\.%04d\..*$', $name, $_);
  }
  return @ret;
}

sub lastMonths($) {
  my $name = shift;
  my $yr =  (localtime($now))[5] + 1900 - int($keepmonths / 12);
  my $tom = (localtime($now))[4] + 1;
  my $fom = $tom - ($keepmonths % 12) + 1;
  if ($fom <= 0) {
    $yr--;
    $fom += 12;
  }

  my @ret;
  for (1 .. $keepmonths) {
    push @ret, sprintf('^%s\.%04d\.%02d\..*$', $name, $yr, $fom);
    $fom++;
    if ($fom > 12) {
      $fom = 1;
      $yr++;
    }
  }
  return @ret;
}

sub lastWeeks($) {
  my $name = shift;
  my $tm = $now;
  my $dy = 60 * 60 * 24;
  my $week = $dy * 7;
  # Hunt backwards for the previous sunday.
  while ((localtime($tm))[6] > 0) {
    $tm -= $dy;
  }
  $tm -= ($keepweeks - 1) * $week;
  my @ret;
  for (1 .. $keepweeks) {
    my ($day, $mon, $yr) = (localtime($tm))[3..5];
    push @ret, sprintf('^%s\.%04d\.%02d\.%02d\..*$', $name, $yr + 1900, $mon + 1, $day);
    $tm += $week;
  }
  # print "Weeks:\n  " . join("\n  ", @ret) . "\n";
  return @ret;
}

sub lastDays($) {
  my $name = shift;
  my $tm = $now;
  my $dy = 60 * 60 * 24;
  $tm -= ($keepdays - 1) * $dy;
  my @ret;
  for (1 .. $keepdays) {
    my ($day, $mon, $yr) = (localtime($tm))[3..5];
    push @ret, sprintf('^%s\.%04d\.%02d\.%02d\..*$', $name, $yr + 1900, $mon + 1, $day);
    $tm += $dy;
  }
  return @ret;
}

sub lastHours($) {
  my $name = shift;
  my $tm = $now;
  my $hr = 60 * 60;
  $tm -= ($keephours - 1) * $hr;
  my @ret;
  for (1 .. $keephours) {
    my ($hour, $day, $mon, $yr) = (localtime($tm))[2..5];
    push @ret, sprintf('^%s\.%04d\.%02d\.%02d\.%02d\..*$', $name, $yr + 1900, $mon + 1, $day, $hour);
    $tm += $hr;
  }
  return @ret;
}

sub cleanAndLatest($$) {
  my $name = shift;
  my $folder = shift;
  opendir DIR, $folder or die "Unable to read folder $folder: $!";
  my @files;
  my $dir;
  foreach $dir (readdir DIR) {
    next unless -d "$folder/$dir";
    next if $dir =~ m/^trash\..*/;
    next if -l "$folder/$dir";
    if ($dir =~ m/(yearly|monthly|weekly|daily|hourly|adhoc)\.\d+/) {
      my $os = 0;
      my $nname;
      do {
        my $cid = buildID((stat "$folder/$dir")[9] + $os);
        $nname = "$name.$cid";
        $os += 60;
      } while (-x "$folder/$nname");
      print "renaming $folder/$dir to $folder/$nname\n";
      mysys("mv", "$folder/$dir", "$folder/$nname") or die "Unable to move file.";
      $dir = $nname;
    }
    next unless $dir =~ m/$name\.\d\d\d\d\.\d\d\.\d\d\.\d\d.\d\d/;
    push @files, $dir;
  }
  closedir DIR;
  return undef unless @files;

  # my @tokeep;
  my @toremove;
  my @rules;
  # Add the year rules...
  push @rules, lastYears $name;
  push @rules, lastMonths $name;
  push @rules, lastWeeks $name;
  push @rules, lastDays $name;
  push @rules, lastHours $name;

  print "Rules:\n  " .join ("\n  ", @rules) . "\n";
  @files = sort @files;
  my $latest;
  foreach $dir (@files) {
    my $found = 0;
    my $rn = 0;
    while ($rn < @rules) {
      if ($dir =~ m/$rules[$rn]/) {
        $found = 1;
        $latest = $dir;
        print "Matched $dir to rule " . $rules[$rn] . "\n";
        splice @rules, $rn, 1;
        last;
      } else {
        $rn++;
      }
    }
    # push @tokeep, $dir if $found;
    push @toremove, $dir unless $found;
  }

  print "Latest is $latest\n";

  # exit 1;

  foreach (@toremove) {
    mysys("mv", "$folder/$_", "$folder/trash.$_") or die "Unable to rename file to trash";
  }

  return $latest;

}

sub processSnapshot {
  my $name = shift;
  my $folder = $sourcefolders{$name};
  my $exclude = $excludes{$name};
  my $outdir = "$snapdir/$name";
  if ($exclude) {
    # Make the exclude relative to the output dir unless it is already absolute.
    $exclude = "$outdir/$exclude" unless $exclude =~ m/^\/.*/;
  } else {
    $exclude = "";
  }
  if ($exclude and ! -r $exclude) {
    # print "Exclude file $exclude does not exist! Ignoring it!\n";
    $exclude = "";
  }
  print "\n\nSnapshot $name:  $folder \@ " . localtime() ."\n";
  -d $outdir or mysys("mkdir", "-p", "$outdir") or die "Unable to make folder $outdir";

  my $mysnaplock = "$outdir/.snapshot.lock";
  $strt = time();
  mysys("lockfile", "-5", "-r-1", "$mysnaplock");
  $snaplock = $mysnaplock;
  print "Locked snapshot folder with $snaplock in " . ( time() - $strt ) . " seconds\n";

  my $tmpdir = "$outdir/tmpsnap";
  -d $tmpdir and die "There already is a folder $tmpdir. Perhaps a previous snapshot was aborted. Please clean this up before we can continue.\n";
  my $latest = cleanAndLatest($name, $outdir);
  $rmtmpdir = $tmpdir;
  if ($latest) {
    print "Using previous snapshot $outdir/$latest as the baseline.\n";
    mysys("cp", "-alH", "$outdir/$latest", "$tmpdir") or die "Failed to create linked copy of latest snapshot $latest!";
  } else {
    print "No previous snapshot baseline.\n";
    mysys("mkdir", "-p", "$tmpdir");
  }
  my @args;
  push @args, "-v", "-a", "--delete";
  if ($exclude){
    print "****  Using Exclude file $exclude ****\n";
    push @args, "--exclude-from=$exclude", "--delete-excluded";
  }
  mysys("rsync", @args, "$folder/", "$tmpdir/") or die "Unable to complete rSync!";
  mysys("mv", "$tmpdir", "$outdir/$name.$id") or die "Unable to rename rSync!";
  $rmtmpdir = "";
  mysys("rm", "-f", "$snaplock");
  $snaplock="";
  print "Completed snapshot for $folder in to $outdir/$name.$id \@ " . localtime() . "\n\n\n";
}

Answer 1

Well, this is actually pretty decent code. There still is a lot of stuff that could be improved, I tried to focus on some more relevant ones.

Subroutine Prototypes

In a declaration like sub foo ($@&*) { ... }, we call the weird thing in parens a prototype. The prototype primarily changes how a call to that sub is parsed, and can set properties like context for the arguments. Contrary to popular belief, prototypes are not required in order to call a subroutine without parens – predeclaration (e.g. via sub foo;) is sufficient.

Prototypes do not generally verify the type of the arguments. Instead, $ or @ or % impose a certain context on that argument – my @foo = (1, 2, 3); bar @foo will pass 1, 2, 3 as arguments to bar if it has no prototype or some list prototype, or it will evaluate the expression @foo is scalar context with a $ prototype, thus passing 3 – the length of the array.

Prototypes are useless, as they can be disabled by invoking a function via the & sigil: &foo(...). Prototypes are a hindrance, because it's often not obvious that they change the context of an expression. Prototypes should not be used, unless you're trying to write something like push or map, which actually need them.

Your mysys has the (;@) prototype, which is especially funny. ; starts optional arguments, and @ allows a list of arbitrary length (including zero arguments). So it's equivalent to (@) which is equivalent to no prototype at all.

Your lastX and cleanAndLatest subs use prototypes in a misguided attempt to limit the number of arguments. Instead, check the size of @_ if you have to do this, e.g. die "The sub lastHour takes exactly one argument" if @_ != 1.

say > print

The [say]say builtin function is available since perl 5.10.0 (released 2007). It behaves exactly like print, except that it will append "\n" to the output instead of $\. This makes it insanely handy for text output. You can activate this function with

use feature 'say';

Shell commands vs. builtins

Perl's history as an Unix sysadmin language means that it has many builtin functions. Using these has the advantage that you can do better error handling, don't waste resources by starting an external process, and have a truly portable interface. The downside is that they are sometimes not quite as flexible, and might need a bit of boilerplate.

Instead of lockfile, use the flock builtin. E.g:

use POSIX qw/:flock/; # import constants

open my $lock_fh, ">", $lockfile or die "Can't open $lockfile: $!";
flock $lock_fh, LOCK_EX or die "Can't obtain lock on $lockfile";

...

flock $lock_fh, LOCK_UN or die "Can't unlock $lockfile";
close $lock_fh;
unlink $lockfile or die "Can't remove lockfile $lockfile";

Oh, all those horrible or dies. Since perl 5.10.1 (released 2009), the autodie module is available which replaces most built-in functions by versions that die on failure rather than relying on you to handle their return code. I highly recommend you use it.

Back to flock: It places an advisory lock on the file, and is blocking by default – there is no way to wait for x seconds, then fail (unless you whish to set an alarm). You can however use the nonblocking version flock $fh, LOCK_EX | LOCK_UN which returns immediately, possibly failing.

Instead of rm, you can use the unlink builtin.

Instead of mv, you can sometimes use rename. However, there are annoying portability issues and it won't work across file system boundaries (which is the case here). The File::Copy module (in Core since perl 5.002 (released 1996)) comes to the rescue, and offers the move and copy functions:

use File::Copy;

# move will either rename, or copy, then unlink
move $source => $destination or die "Couldn't move $source to $destination: $!";
copy $source => $destination or die "Couldn't copy $source to $destination: $!";

While the shell commands are certainly more handy, you should evaluate whether the alternative may be safer.

Assorted Spotlights

• This snippet here is hilarious:

  my @cl;
  push @cl, @_;
  my $msg = '"' . join ('" "', @cl) . '"';
  print "Running $msg\n";
  

  I would write it as:

  my ($program, @arguments) = @_;
  say "Running ", join ' ' => $program, map qq("$_"), @arguments;
  

  While equally obfuscated, the argument unpacking clearly shows what the parameters mean – @cl isn't the best variable name ever. Using map qq("$_") clearly shows the intent that you want to put quotes around each item, join ' ' shows that you want a space in between. Your solution is equivalent, but harder to grok if you aren't aware of that specific pattern.

  The part where your solution is better than mine is using a variable for the combined command.

• In order to avoid accidentally global variables, I tend to put the main part of a script into a main subroutine, then invoke it as exit main(@ARGV) at the top, directly after initializing those variables that are actually intended to be global.

• open CONFIG, "< $configfile" or die ... – no.

  1. We, writing modern Perl, only use lexical variables for filehandles. The bareword CONFIG is effectively a package variable, which has all kinds of unintended side effects.

  2. In order to process even the most exotic filenames, you should use the three-argument form of open. I.e. the second argument only contains the mode, not the filename.

  Together:

  open my $config, "<", $configfile or die ...
  

• Overly eager stringification like "$proglock" is useless in most cases. A value will be made to a string if needed, we don't have to manually facilitate this. Such an expression only makes yet another copy, which is generally useless. (Yes, it also protects you against an evil programmer using out-arguments in his subroutines. However, it's the norm that parameters are not modified, so this wouldn't be much of a threat).

• Two-space indentation? Really? 4-space is the bestest!!1 But I think we can agree that tabs are worse ;-)

• The localtime function has a horrible design and requires you to remember indices of all the fields. However, there's the Time::localtime module (in Core since perl 5.004 (released 1997)) which fixes this:

  (localtime($now))[5]
  

  becomes

  localtime($now)->year