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