equal
deleted
inserted
replaced
6 |
6 |
7 use constant USAGE => <<'#'; |
7 use constant USAGE => <<'#'; |
8 |
8 |
9 Usage: !ME! --insert item [delay [db]] # insert an item |
9 Usage: !ME! --insert item [delay [db]] # insert an item |
10 !ME! --list [db] # list all items |
10 !ME! --list [db] # list all items |
11 !ME! --stat [db ...] # print short statistic |
11 !ME! --stat [db* ...] # print short statistic |
12 !ME! --clean [days [db ...]] # remove items not used since <days> days |
12 !ME! --clean [days [db* ...]] # remove items not used since <days> days |
13 !ME! --purge [days [db ...]] # remove items older than <days> days |
13 !ME! --purge [days [db* ...]] # remove items older than <days> days |
14 !ME! --dbs [glob] # list dbm files in default directory |
14 !ME! --dbs [db* ...] # list data base(s) |
15 |
15 |
16 Defaults: delay: !$DEFAULT{delay}! |
16 db -- single name of database |
17 db: !$DEFAULT{db}! |
17 db* -- glob pattern of database |
18 days: !$DEFAULT{days}! |
18 |
|
19 If the data base name doesn't doesn't start with "./" or "/" |
|
20 it is considered to be realtiv to exim_spool_dir/grey/. |
|
21 |
19 # |
22 # |
20 |
23 |
21 use strict; |
24 use strict; |
22 use warnings; |
25 use warnings; |
23 use Getopt::Long; |
26 use Getopt::Long; |
28 use POSIX qw/strftime mktime/; |
31 use POSIX qw/strftime mktime/; |
29 |
32 |
30 do "@LIBDIR@/exigrey.pl" |
33 do "@LIBDIR@/exigrey.pl" |
31 or do "./exim-exigrey.pl" or die $!; |
34 or do "./exim-exigrey.pl" or die $!; |
32 |
35 |
33 my %DEFAULT = getDefault(); |
|
34 $DEFAULT{days} = 7; |
|
35 |
|
36 my $opt_list; |
36 my $opt_list; |
37 my $opt_stats; |
37 my $opt_stats; |
38 my $opt_insert; |
38 my $opt_insert; |
39 my $opt_help; |
39 my $opt_help; |
40 my $opt_clean; |
40 my $opt_clean; |
41 my $opt_purge; |
41 my $opt_purge; |
42 my $opt_dbs; |
42 my $opt_dbs; |
43 |
43 |
44 sub getDBs($); |
44 sub getDBs(@); |
45 sub iterate(\%$); |
45 sub iterate(\%$); |
46 |
46 |
47 MAIN: { |
47 MAIN: { |
48 |
48 |
49 GetOptions( |
49 GetOptions( |
62 }; |
62 }; |
63 |
63 |
64 |
64 |
65 if ($opt_list) { |
65 if ($opt_list) { |
66 my %h; |
66 my %h; |
67 connectDB(\%h, shift || $DEFAULT{db}); |
67 connectDB(\%h, shift); |
68 iterate(%h, sub { |
68 iterate(%h, sub { |
69 my ($item, $v0, $v1, $dv) = @_; |
69 my ($item, $v0, $v1, $dv) = @_; |
70 printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", |
70 printf "%-16s:\t$v0 $v1 (%3ds %s %s)\n", |
71 $item, $dv, |
71 $item, $dv, |
72 strftime("%F %T", localtime($v0)), |
72 strftime("%F %T", localtime($v0)), |
74 }); |
74 }); |
75 exit 0; |
75 exit 0; |
76 } |
76 } |
77 |
77 |
78 if ($opt_stats) { |
78 if ($opt_stats) { |
79 @ARGV = ($DEFAULT{db}) unless @ARGV; |
79 foreach (@ARGV = getDBs(@ARGV)) { |
80 @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; |
|
81 foreach (@ARGV) { |
|
82 my %h; |
80 my %h; |
83 my $db = connectDB(\%h, $_); |
81 my $db = connectDB(\%h, $_); |
84 |
82 |
85 my ($seen, $returned, $oldest_c, $oldest_u); |
83 my ($seen, $returned, $oldest_c, $oldest_u); |
86 $oldest_c = $oldest_u = time(); |
84 $oldest_c = $oldest_u = time(); |
115 } |
113 } |
116 |
114 |
117 if ($opt_clean or $opt_purge) { |
115 if ($opt_clean or $opt_purge) { |
118 |
116 |
119 my $cut = time() - (86400 * (@ARGV ? shift : 7)); |
117 my $cut = time() - (86400 * (@ARGV ? shift : 7)); |
120 |
118 foreach (getDBs(@ARGV)) { |
121 @ARGV = ($DEFAULT{db}) unless @ARGV; |
|
122 @ARGV = getDBs($ARGV[0]) if $ARGV[0] =~ /[\*\?]/; |
|
123 |
|
124 foreach (@ARGV ? @ARGV : $DEFAULT{db}) { |
|
125 my %h; |
119 my %h; |
126 my $tmp = tmpfile(); |
120 my $tmp = tmpfile(); |
127 my $db = connectDB(\%h, $_); |
121 my $db = connectDB(\%h, $_); |
128 iterate(%h, sub { |
122 iterate(%h, sub { |
129 my ($item, $v0, $v1, $dv) = @_; |
123 my ($item, $v0, $v1, $dv) = @_; |
143 } |
137 } |
144 exit 0; |
138 exit 0; |
145 } |
139 } |
146 |
140 |
147 if ($opt_dbs) { |
141 if ($opt_dbs) { |
148 print join("\n", getDBs(shift || "*")), "\n"; |
142 print join("\n", getDBs(@ARGV)), "\n"; |
149 exit 0; |
143 exit 0; |
150 } |
144 } |
151 |
145 |
152 if ($opt_insert) { |
146 if ($opt_insert) { |
153 print unseen(@ARGV); |
147 print unseen(@ARGV); |
154 exit 0; |
148 exit 0; |
155 } |
149 } |
156 } |
150 } |
157 |
151 |
158 sub getDBs($) { |
152 sub getDBs(@) { |
159 glob(getDBDir() . "/$_[0]"); |
153 grep { -f } map { m(^\.?/) ? glob($_) : glob(getDBDir() . "/$_") } @_ ? @_ : "*"; |
160 } |
154 } |
161 |
155 |
162 # Helper to iterate over our hash and call the passed |
156 # Helper to iterate over our hash and call the passed |
163 # "callback" function (item, v0, v1, delta) |
157 # "callback" function (item, v0, v1, delta) |
164 sub iterate(\%$) { |
158 sub iterate(\%$) { |