view release on metacpan or  search on metacpan

bin/qqtool.pl  view on Meta::CPAN

        foreach my $hash (@$queue) {

            #use Data::Dumper; print Dumper($hash);
            my $header = headers_get( $hash->{'tree'}, $hash->{'num'} );
            my $id = "$hash->{'tree'}/$hash->{'num'}";
            print "id: $id\n";

            unless ($opt_s) {
                message_print( $id, $header );
                next;
            }

            if ($opt_h) {
                message_print( $id, $header )
                  if ( $header->{$opt_h} =~ /$opt_s/ );
            }
            else {
                foreach my $key ( keys %$header ) {
                    if ( $header->{$key} =~ /$opt_s/ ) {
                        message_print( $id, $header );
                        exit;
                    }
                }
            }
        }
    }
}

sub message_print {

    my ( $id, $header ) = @_;

    print "message # $id ";
    print "To:       $header->{'To'}\n";
    print "From:     $header->{'From'}\n";
    print "Subject:  $header->{'Subject'}\n";

    if ($opt_v) {
        if ( $header->{'CC'} ) {
            print "CC:        $header->{'CC'}\n";
        }
        print "Date:      $header->{'Date'}\n";
        my $rp = `head -n1 "$qdir/info/$id"`;
        print "Return Path: $rp\n";
    }

    print "\n";
}

sub headers_get {

    my ( $tree, $id ) = @_;
    my %hash;

    my ($FILE, $header);

    # a better way to read in the headers
    # from http://perl.plover.com/lp/Spam.html
    if ( open $FILE, '<', "$qdir/mess/$tree/$id" )
    {
        local $/ = "";     # enable localized slurp mode
    	$header = <$FILE>; # read in the message headers
    	undef $/;          # reset it back to normal
    	#$body = <STDIN>;
    };

    foreach my $line ( split /\n/, $header ) {
        #print "$line\n"; sleep 1;
        if ( $line =~ /^([a-zA-Z\-]*):\s+(.*?)$/ ) {
            print "header: $line\n" if $opt_v;
            $hash{$1} = $2;
        }
        else {
            print "body: $line\n" if $opt_v;
        }
    }
    return \%hash;
}

sub messages_get {

    my ($qsubdir) = @_;
    my $queue = "$qdir/$qsubdir";    # /var/qmail/queue/[local|remote]

    my ( @messages, $up1dir, $id, $bucket, $queu );

    unless ( -e $queue ) {
        print "ERROR: queue $queue does not exist!\n";
        return 0;
    }
    unless ( -d $queue ) {
        print "ERROR: queue $queue is not a directory!\n";
        return 0;
    }

    unless ( -r $queue ) {
        print "ERROR: queue $queue is not readable by you!\n";
        return 0;
    }

    # eache queue has "buckets" within it that we need to iterate over
    foreach my $queue_buckets ( get_dir_files( $queue ) ) {

        # within each bucket is files that contain the email address we
        # are trying to deliver to.

        foreach my $file ( get_dir_files( $queue_buckets ) ) {

            # id is the message id
            ($id, $up1dir)      = fileparse($file); chop $up1dir;
            ($bucket, $up1dir)  = fileparse($up1dir); chop $up1dir;
            ($queu,   $up1dir)  = fileparse($up1dir);

            print "messages_get: id: $id\n" if ($opt_v);

            my %message_details = (
                num  => $id,
                file => $file,
                tree => $bucket,
                queu => $queu
            );