2 # class to handle all dupes in the system
4 # each dupe entry goes into a tied hash file
6 # the only thing this class really does is provide a
7 # mechanism for storing and checking dups
16 use vars qw{$lasttime $dbm %d $default $fn};
18 $default = 48*24*60*60;
20 $fn = "$main::data/dupefile";
22 use vars qw($VERSION $BRANCH);
23 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
24 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0));
25 $main::build += $VERSION;
26 $main::branch += $BRANCH;
30 $dbm = tie (%d, 'DB_File', $fn);
33 dbg("Dupefile $fn corrupted, removing...");
35 $dbm = tie (%d, 'DB_File', $fn) or confess "can't open dupe file: $fn ($!)";
36 confess "cannot open $fn $!" unless $dbm;
63 my $t = shift || $main::systime + $default;
76 if ($main::systime - $lasttime >= 3600) {
78 while (($k, $v) = each %d) {
79 push @del, $k if $main::systime >= $v;
81 delete $d{$_} for @del;
82 $lasttime = $main::systime;
90 while (($k, $v) = each %d) {
91 push @out, $k, $v if !$start || $k =~ /^$start/;
102 $regex =~ s/[\^\$\@\%]//g;
103 $regex = ".*$regex" if $regex;
104 $regex = "^$let" . $regex;
106 for (sort { $d{$a} <=> $d{$b} } grep { m{$regex}i } keys %d) {
107 my ($dum, $key) = unpack "a1a*", $_;
108 push @out, "$key = " . cldatetime($d{$_} - $dupage) . " expires " . cldatetime($d{$_});