#!/usr/bin/perl
##################################################
# mop -- Überflüssige Backup-Dateien löschen
# Mike Schilli, 2001 (m@perlmeister.com)
##################################################
use 5.6.0;
use warnings;
use strict;

use File::Basename;
use Getopt::Std;
use Date::Calc qw(Today Add_Delta_Days 
                  Add_Delta_YMD Day_of_Week);

my $BAK_DIR = "/data/backups";

    # Kommandozeilenoptionen einsammeln
my %OPTS;
eval { local $SIG{__WARN__} = sub {};
       getopts('nv', \%OPTS); 
     } or usage("Bad option");

my %files        = ();
my %dates_needed = ();

    # Gewünschte Backup-Tage errechnen
calc_dates(\%dates_needed);

    # Backup-Dateien analysieren
for my $file (<$BAK_DIR/*>) {
        # mtime als Hash-Value speichern
    $files{$file} = (stat $file)[9];
}

    # Nach letztem Modifikationszeitpunkt 
    # sortiert durchlaufen
for my $file (sort { $files{$a} <=> $files{$b} } 
              keys %files) {
    my $mtime = $files{$file};
    my ($md, $m, $y) = (localtime($mtime))[3..5];
    my $date = sprintf "%d %d %d",
                       $y + 1900, $m+1, $md;

    if(exists $dates_needed{$date} or
       $date eq join ' ', Today()) {
        print "Keeping $file\n" if $OPTS{v};
            # Datum entfernen -- nur erste Datei
            # eines Tages wird aufgehoben
        delete $dates_needed{$date};
    } else {
        if($OPTS{n}) {
            print basename($file), 
                  " can go away.\n";
        } else {
            unlink $file or 
                die "Cannot unlink $file ($!)";
    
            print basename($file), 
                " deleted.\n" if $OPTS{v};
        }
    }
}

##################################################
sub calc_dates {
##################################################
    my ($needed) = @_;

        # Erwünschte Backup-Tage errechnen
    my @today        = Today();

        # Tage letzter Woche
    for my $delta (1..7) {
       my @date = Add_Delta_Days(@today, -$delta); 
       $needed->{"@date"} = 1; 
    }

        # Die letzten 4 Montage
    my $current_dow = Day_of_Week(@today);
    my @last_monday;
    if($current_dow == 1) {
        # Heute ist Montag
        @last_monday = Add_Delta_Days(@today, -7);
    } else {
        # Heute ist nicht Montag
        @last_monday = Add_Delta_Days(@today, 
                                  1-$current_dow);
    }
    for my $weeks_back (0..3) {
        my @date = Add_Delta_Days(@last_monday,
                                $weeks_back * -7);
        $needed->{"@date"} = 1; 
    }

        # Die letzten 3 Monatsersten
    my @last_first;
    if($today[2] == 1) {
            # Heute ist der Monatserste
        @last_first = Add_Delta_YMD(@today, 
                                    0, -1, 0);
    } else {
            # Heute ist nicht der Monatserste
        @last_first = ($today[0], $today[1], 1);
    }
    for my $months_back (0..2) {
        my @date = Add_Delta_YMD(@last_first, 0, 
                            -1 * $months_back, 0);
        $needed->{"@date"} = 1; 
    }
}

##################################################
sub usage {
##################################################
    my ($message) = @_;
    my $program = basename($0);

    print <<EOT;
$program: $message
usage: $program [-nv]
    -n: Don't actually delete
    -v: Print informative messages
EOT
    exit 1;
}