Hi,
Thanks everyone for your offer to help. I've posted below a complete program that runs on my system. Where it encounters an error and quits, it displays the following, with a few of the preceding lines:
bucket: aa type: spam 2012-07-02 20120702T132446
bucket: aa type: spam 2012-07-07 20120707T083754
bucket: aa type: spam 2012-07-02 20120702T203543
bucket: aa type: virus 2012-07-08 20120708T113543
bucket: aa type: spam 2012-07-16 20120716T151849
bucket: aa type: virus 2012-07-22 20120722T100147
bucket: aa type: spam 2012-07-03 20120703T042249
bucket: aa type: spam 2012-07-07 20120707T204829
Use of uninitialized value in split at ./list_hash.pl line 32.
Use of uninitialized value $dt in pattern match (m//) at ./list_hash.p
+l line 35.
key 2 not defined. Deleting.
It's reading from 255 hashes for each host, which you aren't going to have, so it probably won't execute for you.
As I mentioned previously, the delete() isn't actually deleting for some reason. If I run the program again, it dies at the same spot, indicating to me that the record with the undef'd value or key still remained.
Any ideas greatly appreciated.
#!/usr/bin/perl -w
# use perl;
use DB_File;
use DBI;
use File::Basename qw(basename);
use strict;
use vars qw($verbose);
my $me = basename($0); $me =~ s/\.pl$//;
$verbose = shift || 1;
sub DBG($);
my $qdir = '/var/www/noc.mydomain.com-80/';
my %hashes = ( );
my $version = '1.9';
my @mailhosts = qw();
push @mailhosts, 'mail01';
push @mailhosts, 'mail02';
foreach my $mhosts (@mailhosts) {
for (my $i = 0; $i < 256; $i++) {
my $bucket = sprintf('%02x', $i);
my $file = sprintf('%s/%s/%02x.db', $qdir, $mhosts, $i);
tie (my %hash, 'DB_File', $file, O_RDWR, 0600, $DB_HASH) || next;
foreach my $key ( keys %hash ) {
my @tmp = split /\t/, $hash{$key}, 7;
my $type = $tmp[0];
my $dt = $tmp[1];
my ($year, $month, $day) = $dt =~ m|(\d{4})(\d{2})(\d{2})T.*|;
if(!defined($year)) { DBG("key 2 not defined. Deleting.\n"); de
+lete($hash{$key}); untie %hash; exit 1; };
if(!defined($month)) { DBG("key 3 not. Deleting.\n"); delete($h
+ash{$key}); untie %hash; exit 1; };
if(!defined($day)) { DBG("key 4 not defined. Deleting.\n"); del
+ete($hash{$key}); untie %hash; exit 1; };
printf("bucket: %s\ttype: %s\t%s-%s-%s\t%s\n",$bucket,$type,$ye
+ar,$month,$day,$dt)
}
untie %hash;
}
} # end foreach mailhost
sub DBG($) { my $msg = shift; print $msg if ($verbose); }
Version with line numbers:
1 #!/usr/bin/perl -w
2
3 # use perl;
4 use DB_File;
5 use DBI;
6 use File::Basename qw(basename);
7 use strict;
8 use vars qw($verbose);
9
10 my $me = basename($0); $me =~ s/\.pl$//;
11 $verbose = shift || 1;
12
13 sub DBG($);
14
15 my $qdir = '/var/www/noc.mydomain.com-80/';
16 my %hashes = ( );
17
18 my $version = '1.9';
19 my @mailhosts = qw();
20
21 push @mailhosts, 'mail01';
22 push @mailhosts, 'mail02';
23
24 foreach my $mhosts (@mailhosts) {
25 for (my $i = 0; $i < 256; $i++) {
26 my $bucket = sprintf('%02x', $i);
27 my $file = sprintf('%s/%s/%02x.db', $qdir, $mhosts, $
+i);
28
29 tie (my %hash, 'DB_File', $file, O_RDWR, 0600, $DB_HASH)
+ || next;
30 foreach my $key ( keys %hash ) {
31
32 my @tmp = split /\t/, $hash{$key}, 7;
33 my $type = $tmp[0];
34 my $dt = $tmp[1];
35 my ($year, $month, $day) = $dt =~ m|(\d{4})(\d{2})(\d
+{2})T.*|;
36 if(!defined($year)) { DBG("key 2 not defined. Deletin
+g.\n"); delete($hash{$key}); untie %hash; exit 1; };
37 if(!defined($month)) { DBG("key 3 not. Deleting.\n");
+ delete($hash{$key}); untie %hash; exit 1; };
38 if(!defined($day)) { DBG("key 4 not defined. Deleting
+.\n"); delete($hash{$key}); untie %hash; exit 1; };
39 printf("bucket: %s\ttype: %s\t%s-%s-%s\t%s\n",$bucket
+,$type,$year,$month,$day,$dt)
40
41 }
42 untie %hash;
43 }
44 } # end foreach mailhost
45
46 sub DBG($) { my $msg = shift; print $msg if ($verbose); }
47
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.