jeremywohl / glastree

Builds live backup trees, with branches for each day.

This URL has Read+Write access

glastree / glastreeprune
100755 114 lines (84 sloc) 2.326 kb
raw blame history 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

#!/usr/bin/perl
 
#
# glastreeprune -- list glastree directories outside our window
#
#  Jeremy Wohl (http://igmus.org/code)
#  Public domain; no warranty, no responsibility, etc.
#
#  $Id: glastreeprune,v 1.4 2002/06/30 22:23:37 jeremyw Exp $
#
 
require 5.002;
 
use English;
use Getopt::Long;
use DirHandle;
use Cwd qw (getcwd);
use Date::Calc qw (Today Add_Delta_Days Delta_Days);
use strict;
 
use vars qw/ @boundary @prunedirs %pruneym $KEEP $TANK /;
 
$KEEP = 1;
$TANK = 0;
 
use vars qw/ $opt_days   /;
use vars qw/ $opt_print0 /;
use vars qw/ $opt_help   /;
 
main ();
 
sub main
{
    my ($target, $prunedays, $linesep);
 
    #
    # handle options
    #
 
    GetOptions ('days=i', 'print0', 'help');
    
    if ($opt_help or not defined @ARGV or scalar @ARGV != 1)
    {
	print STDERR "usage: glastreeprune [options] backupdir\n\n";
	print STDERR "options:\n";
	print STDERR "  --days=n             Keep last n days (from today); default is 30\n";
	print STDERR "  --print0             Separate lines by NUL, preserving embedded newlines\n";
	#print STDERR "  --backups=n          Keep last n backups\n";
	print STDERR "  --help               Display this message and exit\n";
	exit 1;
    }
 
    $target = $ARGV [0];
 
    if (not defined $opt_days) {
	$prunedays = 30;
    } else {
	$prunedays = $opt_days;
    }
 
    if (not defined $opt_print0) {
	$linesep = "\n";
    } else {
	$linesep = "\0";
    }
 
    #
    # figure marcation
    #
 
    @boundary = Add_Delta_Days (Today (), -$prunedays);
 
    #
    # go
    #
 
    prunerecurse ("$target", 0);
    foreach (@prunedirs) { print $_, $linesep; }
 
    foreach (keys %pruneym) { print "$target/$_", $linesep if $pruneym {$_} == $TANK; }
}
 
 
sub prunerecurse ($cwd, $level)
{
    my ($cwd, $level) = @_;
    my ($dir, @list, @dirs);
 
 
    return if ($dir = new DirHandle ($cwd)) == undef;
 
    @list  = $dir->read;
    @dirs  = grep { /^[^\.]/ && -d "$cwd/$_" } @list;
    undef $dir;
 
    if ($level == 1) {
	foreach (@dirs) {
	    next if "$cwd/$_" !~ m!(\d\d\d\d)(\d\d)/(\d\d)$!;
 
	    if (Delta_Days (@boundary, $1, $2, $3) > 0) {
		$pruneym {$1 . $2} = $KEEP;
		next;
	    }
 
	    push (@prunedirs, "$cwd/$_");
 
	    $pruneym {$1 . $2} = $TANK if not defined $pruneym {$1 . $2};
	}
	return;
    }
 
    foreach (@dirs)  { prunerecurse ("$cwd/$_", $level + 1); }
}