--- a/ftbackup	Thu Apr 14 17:03:06 2011 +0200
+++ b/ftbackup	Fri Apr 15 13:17:20 2011 +0200
@@ -9,7 +9,6 @@
 use Perl6::Slurp;
 use Getopt::Long;
 use Sys::Hostname;
-use Time::Local;
 use Pod::Usage;
 use POSIX qw(strftime);
 use Date::Parse qw(str2time);
@@ -42,9 +41,10 @@
 sub get_candidates();
 sub verbose(@);
 sub update_devnames($$$);
-sub examine(@);
-sub decide($@);
+sub get_history(@);
+sub calculate_level($@);
 sub real_device($);
+sub get_estimate($$);
 sub devno($);
 
 our @AT_EXIT;
@@ -58,7 +58,9 @@
     COMPRESSION_LEVEL => 6,
 );
 
+
 MAIN: {
+
     Getopt::Long::Configure("bundling");
     GetOptions(
         "l|level=i" => \$opt_level,
@@ -86,6 +88,7 @@
     ### %cf
     ### @devs
 
+
     verbose +(map { "candidate: $_->{dev} as $_->{rdev}\n" } @devs), "\n";
 
     my @errors = ();
@@ -110,9 +113,9 @@
         $ftp->try(cwd    => $cf{FTP_DIR});
     }
 
-    # examine the situation - we rely on $opt_dumpdates
-    @devs = examine(@devs);
-    @devs = decide($cf{FULL_CYCLE}, @devs);
+    # get_history the situation - we rely on $opt_dumpdates
+    @devs = get_history(@devs);
+    @devs = calculate_level($cf{FULL_CYCLE}, @devs);
 
     ### @devs
 
@@ -437,7 +440,7 @@
 
 # put the last dump information (level and date) into
 # the device structure - information is obtained from $opt_dumpdates
-sub examine(@) {
+sub get_history(@) {
     my @devs = @_;
     my %dd;
 
@@ -476,24 +479,39 @@
     return @devs;
 }
 
-sub decide($@) {
+sub get_estimate($$) {
+    my ($dev, $level) = @_;
+    warn "% estimating $dev->{rdev} at level $level\n";
+    chomp(my $_ = `dump -S -$level $dev->{rdev}`);
+    return $_;
+}
+
+sub calculate_level($@) {
     my ($cycle, @devs) = @_;
 
     foreach my $dev (@devs) {
 	if (defined $opt_level) {
 	    $dev->{level} = $opt_level;
-	    next;
-	}
-
-	if (!$dev->{last}
+	} 
+	elsif (!$dev->{last}
 	    or not $dev->{last}[0]
 	    or $NOW - $dev->{last}[0] > ($cycle * 86_400)) {
 	    $dev->{level} = 0;
-	    next;
-	}
+	} 
+	else { $dev->{level} = 1 }
 
-	$dev->{level} = 1;
-	    
+	# now we'll see if the level really saves space compared
+	# with the next lower level
+	my @estimates;
+	while (my $l = $dev->{level} > 0) {
+	    $estimates[$l] //= get_estimate($dev, $l);
+	    $estimates[$l - 1] //= get_estimate($dev, $l - 1);
+
+	    last if my $savings = ($estimates[$l-1] - $estimates[$l]) / $estimates[$l-1] >= 0.10;
+	    warn "% savings for level $dev->{level} on $dev->{dev} are @{[int($savings * 100)]}% ",
+		 "will use level ", $dev->{level} - 1, "\n";
+	    --$dev->{level};
+	}
     }
 
     return @devs;