#!/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); }