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.pl line 35.
key 2 not defined. Deleting.

##</code><code>##

#!/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"); delete($hash{$key}); untie %hash; exit 1; };
       if(!defined($month)) { DBG("key 3 not. Deleting.\n"); delete($hash{$key}); untie %hash; exit 1; };
       if(!defined($day)) { DBG("key 4 not defined. Deleting.\n"); delete($hash{$key}); untie %hash; exit 1; };
       printf("bucket: %s\ttype: %s\t%s-%s-%s\t%s\n",$bucket,$type,$year,$month,$day,$dt)	

    }
    untie %hash;
  }
} # end foreach mailhost

sub DBG($) { my $msg = shift; print $msg if ($verbose); }

##</code><code>##

     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. Deleting.\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