View of /DadaFork/DADA/Mail/MailOut.pm

Parent Directory

Revision Log

Base version: DadaMail 2.10.12

# $Id: MailOut.pm,v 1.29.2.3 2006/12/15 04:55:29 skazat Exp $ $Revision: 1.29.2.3 $, $HeadURL$, $Source: /cvsroot/mojomail/dada_mail_stable/dada/DADA/Mail/MailOut.pm,v $ $Date: 2006/12/15 04:55:29 $

package DADA::Mail::MailOut;

use lib qw(../../ ../../DADA ../../perllib);

use Carp qw(croak carp);

use Fcntl qw(

    :DEFAULT
    :flock
    LOCK_SH
    O_RDONLY
    O_CREAT
    O_WRONLY
    O_TRUNC

);

my $dbi_obj;

use DADA::Config qw(!:DEFAULT); # test
my $t = $DADA::Config::DEBUG_TRACE->{DADA_Mail_MailOut}; 

use DADA::App::Guts;
use DADA::Logging::Usage;

my $log = new DADA::Logging::Usage;

require Exporter;
@ISA    = qw(Exporter);
@EXPORT = qw(current_mailouts mailout_exists);

use vars qw(@EXPORT $AUTOLOAD);

use strict;

my $file_names = {

    batchlock           => 'batchlock.txt',
    tmp_subscriber_list => 'tmp_subscriber_list.txt',
    num_sending_to      => 'num_sending_to.txt',
    counter             => 'counter.txt',
    first_access        => 'first_access.txt', 
    last_access         => 'last_access.txt',
    raw_message         => 'raw_message.txt',

};

my %allowed = (

    message               => undef,
    _internal_message_id  => undef,
    mailout_type          => 'list',
    list                  => undef,
    dir                   => undef,
    subscriber_list       => undef,
    sent_amount           => 0,
    total_sending_out_num => undef,

    #auto_pickup_status   => 0,

);

sub new {

    my $that = shift;
    my $class = ref($that) || $that;

    my $self = {
        _permitted => \%allowed,
        %allowed,
    };

    bless $self, $class;

    my ($args) = @_;

    if ( !$args->{-List} ) {

        carp
            "You need to supply a list ->new({-List => your_list}) in the constructor.";
        return undef;

    }

    if ( $self->_init($args) ) {
        warn 'MailOut object created successfully.' if $t; 
        return $self;
    }
    else {
        warn 'MailOut object was NOT created successfully.' if $t; 

        return undef;
    }
}

sub AUTOLOAD {
    my $self = shift;
    my $type = ref($self)
        or croak "$self is not an object";

    my $name = $AUTOLOAD;
    $name =~ s/.*://;    #strip fully qualifies portion

    unless ( exists $self->{_permitted}->{$name} ) {
        croak "Can't access '$name' field in object of class $type";
    }
    if (@_) {
        return $self->{$name} = shift;
    }
    else {
        return $self->{$name};
    }
}

sub _init {

    my $self = shift;
    my ($args) = @_;

    if ( !$self->_sanity_test($args) ) {

        carp
            "sanity test failed - something's wrong with the paramaters you passed.";
        return undef;

    }
    else {

    }

    require DADA::MailingList::Settings;

    my $ls = DADA::MailingList::Settings->new( -List => $args->{-List} );
    my $li = $ls->get();

    $self->list( $args->{-List} );

    $self->{list_info} = $li;
    $self->{ls_object} = $ls;

    require DADA::MailingList::Subscribers;
    my $lh = DADA::MailingList::Subscribers->new( -List => $args->{-List} );

    $self->{lh_obj} = $lh;

}

sub _sanity_test {

    my $self = shift;
    my ($args) = @_;

    return undef if !$args;

    return $self->_list_name_check( $args->{-List} );

}

sub create {

    my $self = shift;

    my ($args) = @_;

    # = ( -fields => {}, -mh_obj => {}, -list_type => 'list', @_ );

    # default:
    my $list_type = $args->{-list_type} ? $args->{-list_type} : 'list';

    croak "The Actual Message Fields have not been passed. "
        if !keys %{ $args->{-fields} };

    croak "The Message ID has not been passed. "
        if !exists( $args->{-fields}->{'Message-ID'} );

    croak "The DADA::Mail::Send object has not been passed "
        if !exists( $args->{-mh_obj} );

    croak
        "The DADA::Mail::Send object has been passed, but it's not isa DADA::Mail::Send! "
        unless $args->{-mh_obj}->isa('DADA::Mail::Send');

    $self->_internal_message_id( $args->{-fields}->{'Message-ID'} );

    $self->mailout_type($list_type);

    $self->message( $args->{-fields} );

    $self->create_directory();

    # The Temporary Subscriber List
    $self->create_subscriber_list( { -mh_obj => $args->{-mh_obj} } );

    #The Total Amount of Recipients Amount
    $self->create_total_sending_out_num();

    #The Amount Sent Counter
    $self->create_counter();
    
    # Create "First Accessed", File
    $self->create_first_accessed_file; 

    # The, "Last Accessed", File
    $self->create_last_accessed_file();

    # A Copy of the Message Being Sent Out
    $self->create_raw_message();

    #well, I guess I'll return 1 for success...
    return 1;

}

sub associate_with_id {

    my $self = shift;
    my $id   = shift;

    croak "Object already associated with: "
        . $self->_internal_message_id
        . "This can only be set once and is read-only via (_internal_message_id) after that."
        if $self->_internal_message_id;

    $id =~ s/\@/_at_/g;
    $id =~ s/\>|\<//g;

    $self->_internal_message_id($id);

    $self->dir( $self->mailout_directory_name );

    return 1;

}

sub batch_lock {

    my $self = shift;

    $self->create_batch_lock();

    return 1;

}

sub unlock_batch_lock {

    my $self = shift;

    my $file = $self->dir . '/' . $file_names->{batchlock};

    if ( !-e $file ) {
        carp
            "Batch lock not around to unlock?! Could possibly have never been locked (yet)";
    }
    else {

        my $worked = unlink($file);

        if ( $worked == 1 ) {

            return 1;

        }
        else {

            carp "Batch lock could not be unlinked (deleted). Reasons:" . $!;

            if ( -e $file ) {
                carp
                    "File exists check turns up a positive - the batch lock file is *really really* there.";
            }
            else {
                carp
                    "Strange, unlinking didn't work, but the batch lock doesn't seem to be around anymore.";
            }

            return 0;

        }
    }
}

sub is_batch_locked {

    my $self = shift;

    if ( -e $self->dir . '/' . $file_names->{batchlock} ) {

        return 1;

    }
    else {

        return 0;
    }
}

sub create_directory {

    my $self = shift;

    if ( -d $self->mailout_directory_name() ) {
        croak "Mailout directory, '"
            . $self->mailout_directory_name
            . "' already exists?!";
    }

    if ( !-d $self->mailout_directory_name ) {
        croak
            "$DADA::Config::PROGRAM_NAME $DADA::Config::VER warning! Could not create, '$self->mailout_directory_name'- $!"
            unless mkdir( $self->mailout_directory_name, $DADA::Config::DIR_CHMOD  );
        chmod( $DADA::Config::DIR_CHMOD , $self->mailout_directory_name )
            if -d $self->mailout_directory_name;
    }

    if ( !-d $self->mailout_directory_name ) {
        croak "Mailout Directory never created at: '"
            . $self->mailout_directory_name . "'";
    }

    $self->dir( $self->mailout_directory_name );

}

sub mailout_directory_name {

    my $self = shift;
    my $tmp  = $self->_internal_message_id;

    my $letter_id = $tmp;
    $letter_id =~ s/\@/_at_/g;
    $letter_id =~ s/\>|\<//g;

    $letter_id = DADA::App::Guts::strip($letter_id);

    return $DADA::Config::TMP 
        . '/sendout-'
        . $self->{list} . '-'
        . $self->mailout_type . '-'
        . $letter_id;

}

sub create_subscriber_list {

    my $self = shift;

    my ($args) = @_;

    croak
        "The DADA::Mail::Send object has been passed, but it's not isa DADA::Mail::Send! "
        unless $args->{-mh_obj}->isa('DADA::Mail::Send');

    my ( $path_to_list, $total_sending_out_num)
        = $self->{lh_obj}->create_bulk_sending_file(
        -List => $self->{list},
        -ID   => $self->_internal_message_id,
        -Type => $self->mailout_type,

        -Save_At => $self->dir . '/' . $file_names->{tmp_subscriber_list},

        -Bulk_Test      => $args->{-mh_obj}->{bulk_test},
        -Test_Recipient => $args->{-mh_obj}->bulk_test_recipient,

        -Ban           => $args->{-mh_obj}->{do_not_send_to},
        -Sending_Lists => $args->{-mh_obj}->also_send_to,

        );

    if ( !-e $self->dir . '/' . $file_names->{tmp_subscriber_list} ) {
        croak "Temporary Sending List was never created at: '"
            . $self->dir . '/'
            . $file_names->{tmp_subscriber_list} . "'";
    }

    $self->subscriber_list(
        $self->dir . '/' . $file_names->{tmp_subscriber_list} );
    $self->total_sending_out_num($total_sending_out_num);
}

sub create_total_sending_out_num {

    my $self = shift;

    my $file = $self->dir . '/' . $file_names->{num_sending_to};

    sysopen( COUNTER, $file, O_WRONLY | O_TRUNC | O_CREAT, $DADA::Config::FILE_CHMOD  )
        or croak
        "Couldn't create the counter of how many subscribers I need to send to at: "
        . $file
        . " because: "
        . $!;
    print COUNTER $self->total_sending_out_num
        or croak "Couldn't write to: " . $file . "because: " . $!;
    close(COUNTER)
        or croak $file . " didn't close poperly because: " . $!;
}

sub create_counter {

    my $self = shift;

    my $file = $self->dir . '/' . $file_names->{counter};

    sysopen( COUNTER, $file, O_WRONLY | O_TRUNC | O_CREAT, $DADA::Config::FILE_CHMOD  )
        or croak "couldn't open counter at: '$file', Reason:! " . $!;
    print COUNTER '0';
    close(COUNTER)
        or croak $!;

}




sub create_first_accessed_file {

    my $self = shift;
    my $file = $self->dir . '/' . $file_names->{first_access};

    sysopen( ACCESS, $file, O_WRONLY | O_TRUNC | O_CREAT, $DADA::Config::FILE_CHMOD  )
        or croak "Couldn't open '$file', Reason: " . $!;
    print ACCESS time;
    close(ACCESS)
        or croak $!;

}




sub create_last_accessed_file {

    my $self = shift;
    my $file = $self->dir . '/' . $file_names->{last_access};

    sysopen( ACCESS, $file, O_WRONLY | O_TRUNC | O_CREAT, $DADA::Config::FILE_CHMOD  )
        or croak "Couldn't open '$file', Reason: " . $!;
    print ACCESS time;
    close(ACCESS)
        or croak $!;

}

sub create_batch_lock {

    my $self = shift;
    my $file = $self->dir . '/' . $file_names->{batchlock};

    sysopen( BATCHLOCK, $file, O_WRONLY | O_TRUNC | O_CREAT, $DADA::Config::FILE_CHMOD  )
        or croak "Couldn't open, '$file', Reason: " . $!;
    print BATCHLOCK time;
    close(BATCHLOCK)
        or croak $!;

}

sub countsubscriber {

    my $self = shift;

    sysopen( FH, $self->dir . '/' . $file_names->{counter}, O_RDWR | O_CREAT )
        or croak "can't open counter: $!";
    flock( FH, LOCK_EX ) or croak "can't flock counter: $!";
    my $num = <FH> || 0;

    #warn 'counter adding + 1 to: ' . $num if $t;

    seek( FH, 0, 0 ) or croak "can't rewind counter: $!";
    truncate( FH, 0 ) or croak "can't truncate counter: $!";
    ( print FH $num + 1, "\n" ) or croak "can't write counter: $!";
    close FH or croak "can't close counter: $!";

    sysopen( FH,
        $self->dir . '/' . $file_names->{last_access},
        O_RDWR | O_CREAT
    ) or croak "can't open counter: $!";
    flock( FH, LOCK_EX ) or croak "can't flock counter: $!";

    #my $num = <FH> || 0;
    seek( FH, 0, 0 ) or croak "can't rewind counter: $!";
    truncate( FH, 0 ) or croak "can't truncate counter: $!";
    ( print FH time, "\n" ) or croak "can't write counter: $!";
    close FH

}

sub create_raw_message {

    my $self   = shift;
    my $fields = $self->message;

    my $file = $self->dir . '/' . $file_names->{raw_message};

    my $msg;

    sysopen( MESSAGE, $file, O_WRONLY | O_TRUNC | O_CREAT, $DADA::Config::FILE_CHMOD  )
        or croak "couldn't open: " . $file . "because: " . $!;

    foreach (@DADA::Config::EMAIL_HEADERS_ORDER) {
        next if $_ eq 'Body';
        next if $_ eq 'Message';    # Do I need this?!
        print MESSAGE $_ . ': ' . $fields->{$_} . "\n"
            if ( ( defined $fields->{$_} ) && ( $fields->{$_} ne "" ) );
    }

    print MESSAGE "\n" . $fields->{Body};

    close MESSAGE
        or die "Coulnd't close: " . $file . "because: " . $!;

    chmod($DADA::Config::FILE_CHMOD, $file); 

}




sub _integrity_check { 


    my $self = shift; 
    
    foreach my $file_check(keys %$file_names){
    
        next if $file_check eq 'batchlock'; # batchlock can come and go, I guess...
        
        if(! -e $self->dir . '/' . $file_names->{$file_check}){ 
        
            carp "Integrity warning: " . $self->dir . '/' . $file_names->{$file_check} . " is not present!"; 
            return undef;
        }
    
    }
    
    return 1; 

}

sub status {

    my $self = shift;

    $self->dir( $self->mailout_directory_name );

    my $status = {};

     $status->{id} = $self->_internal_message_id;



    if($self->_integrity_check == 0){ 
        $status->{integrity_check} = 0; 
        return $status; 
    } else { 
        $status->{integrity_check} = 1;
    }

   
    $status->{total_sending_out_num}
        = $self->_poll( $self->dir . '/' . $file_names->{num_sending_to} );

    $status->{total_sent_out}
        = $self->_poll( $self->dir . '/' . $file_names->{counter} );

    $status->{last_access}
        = $self->_poll( $self->dir . '/' . $file_names->{last_access} );

   $status->{first_access}
        = $self->_poll( $self->dir . '/' . $file_names->{first_access} );

    $status->{email_fields} = $self->mail_fields_from_raw_message();

    $status->{type} = $self->mailout_type;

    $status->{is_batch_locked} = ( $self->is_batch_locked == 1 ) ? 1 : 0;

    # should be like a + .05 somewhere in here...
    if ( $status->{total_sent_out} > 0 ) {
        
        eval { 
        
        $status->{percent_done} = int(
            int( $status->{total_sent_out} ) /
                int( $status->{total_sending_out_num} ) * 100 );
        };
        
        if($@){ 
            $status->{percent_done} = 0;
        }
    }
    else {
        $status->{percent_done} = 0;
    }

    # NOTE:
    # should_be_restarted
    # and,
    # process_has_stalled
    # Are fairly similar, probably best to use,
    #
    # should_be_restarted
    #
    # instead of the other...

    $status->{should_be_restarted} = $self->should_be_restarted;

    my $process_has_stalled = $self->process_has_stalled;

    $status->{process_has_stalled} = $process_has_stalled;

    # Test for a stalled process -

    if ( $process_has_stalled == 1 ) {

        carp
            "process has stalled. Unlocking batchlock, so it may start again!";

        if ( $status->{total_sent_out} == $status->{total_sending_out_num} ) {
            carp
                "Well, wait, the amount to send out equals the number we have to send out - I think we're done, will unlock anyways, to get around niggly stuff, but expect warnings...";
        }

        $self->unlock_batch_lock();
        $status->{is_batch_locked} = 0;

    }

    return $status;

}

sub should_be_restarted {

    my $self = shift;

    my $last_access
        = $self->_poll( $self->dir . '/' . $file_names->{last_access} );

    if ( $self->{list_info}->{restart_mailings_after_each_batch} == 1 ) {

        # Basically, if the sending process isn't locked, we wait the amount
        # of time we'd usually sleep() and if we're over that time, it's time
        # to send again!

        my $sleep_amount = $self->{list_info}->{bulk_sleep_amount};

        if ( ( $last_access + $sleep_amount ) <= time ) {

            # last access is in the past,
            # sleep amount is in seconds.
            # if *now* is more than the last access time,
            # plus we're supposed to sleep for,
            # we've overslept...

            # Time to restart, as long as the lock isn't there...

            if ( $self->is_batch_locked ) {

                # Well, OK, it's there,
                # but I mean, is it a *stale* lock?!

                if ( $self->process_has_stalled ) {

                    # Process has stalled
                    # And it's time to restart?
                    # let's do it:

                    return 1;

                }
                else {

                    # Let's wager on the side of being conservative
                    # and wait till the lock is officially stale
                    # Before we do anything *rash*

                    return 0;
                }

            }
            else {

                # Sending process is *not* locked?
                # And it's time to restart, let's do it.

                return 1;

            }

        }
        else {

            # not time yet...
            return 0;
        }

    }
    else {

        if ( $self->is_batch_locked ) {

            # Batch is locked.
            # Is the batch stale?

            if ( $self->process_has_stalled ) {

                # Yes? Let's restart.

                return 1;
            }
            else {

                # No? Hold off.

                return 0;
            }
        }
        else {

            # batch ain't locked, huh? Restart!
            return 1;
        }

    }

}

sub process_has_stalled {

    my $self = shift;

    #    carp '$self->process_stalled_after ' . $self->process_stalled_after;

    if ( $self->process_stalled_after <= 0 ) {

        return 1;
    }
    else {
        return 0;
    }
}

sub process_stalled_after {

    my $self = shift;

    my $last_access
        = $self->_poll( $self->dir . '/' . $file_names->{last_access} );
    my $sleep_amount = $self->{list_info}->{bulk_sleep_amount};

    my $countdown = ( ( $sleep_amount * 3 ) + 60 ) - ( time - $last_access );

    return $countdown;

}

sub mail_fields_from_raw_message {

    my $self = shift;

    my $raw_msg = $self->message_for_mail_send;

    # This is way ruff.

    my ( $raw_header, $raw_body ) = split( /\n\n/, $raw_msg, 2 );
    my $headers = {};

    # split.. logically
    my @logical_lines = split /\n(?!\s)/, $raw_header;

    # make the hash
    foreach my $line (@logical_lines) {
        my ( $label, $value ) = split( /:\s*/, $line, 2 );
        $headers->{$label} = $value;
    }

    return $headers;

}

sub _poll {

    my $self = shift;
    my $file = shift;

    croak "No file passed to pole"
        if !$file;

    # Question: What happens if the file does not exist?

    if ( !-e $file ) {
        croak "The file, '" . $file . "'does not exist to poll.";
    }

    sysopen( FH, $file, O_RDWR | O_CREAT ) or die "can't open counter: $!";
    flock( FH, LOCK_SH ) or die "can't flock counter: $!";
    my $num = <FH> || 0;
    close FH or die "can't close counter: $!";

    $num =~ s/^\s+//o;
    $num =~ s/\s+$//o;

    return $num;
}

sub reload {

    my $self = shift;
    my $type = shift;

    croak "You didn't supply a list mailing type (list, black_list invite_list, etc)"
        if !$type;

    # this should also prolly be figured out automatically also...
    $self->mailout_type($type);

    $self->dir( $self->mailout_directory_name() );

    $self->total_sending_out_num(
        $self->_poll( $self->dir . '/' . $file_names->{num_sending_to} ) );

    $self->subscriber_list(
        $self->dir . '/' . $file_names->{tmp_subscriber_list} );

    if ( $self->is_batch_locked ) {

        my $msg
            = "Cannot reload! Sending process is locked! Another process may"
            . " be underway, or,the lock is stale. If so, Will remove"
            . " the stale lock in:  "
            . $self->process_stalled_after
            . "  seconds"
            . "(Call status() to remove the stale lock...";
        croak($msg);

    }
    else {

        carp "Error! Reloading message with no error! (yeah, it's a joke...)";

    }
    return $self->message_for_mail_send;

}

sub counter_at {
    my $self  = shift;
    my $count = $self->_poll( $self->dir . '/' . $file_names->{counter} );

    croak(
        "counter is more than the total number that we're sending out!\n counter: "
            . $count
            . "\n total:"
            . $self->total_sending_out_num )
        if $count > $self->total_sending_out_num;

    return $count;
}

sub message_for_mail_send {

    my $self = shift;

    my $file = $self->dir . '/' . $file_names->{raw_message};

    if ( !-e $file ) {
        die "Raw Message that should be saved at: " . $file . "isn't there.";
    }

    open my $MSG_FILE, '<', $file
        or die "Cannot read saved raw message at: '" . $file
        . "' because: "
        . $!;

    my $msg = do { local $/; <$MSG_FILE> };

    close $MSG_FILE
        or die "Didn't close: '" . $file . "'properly because: " . $!;

    if ( !$msg ) {
        carp "message is blank.";
    }

    return $msg;
}

sub clean_up {

    my $self = shift;

    croak "Make sure to call, 'associate_with_id' before calling cleanup!"
        if ! $self->dir; 
    
    my @deep_six_list;

    foreach my $fn ( keys %$file_names ) {

     # basically, iterate through the type of files that, *may* be in there...
        if ( -e $self->dir . '/' . $file_names->{$fn} ) {
            push( @deep_six_list, $self->dir . '/' . $file_names->{$fn} );
        } else { 
            carp "not attempting removing: " . $self->dir . '/' . $file_names->{$fn} . '. Reason: not present.(?)'; 
        }

    }

    my $d6_count = unlink(@deep_six_list);

    unless ( $d6_count == $#deep_six_list + 1 ) {
        carp "something didn't get removed! ($d6_count)";
        return 0; 
    }

    if ( rmdir( $self->dir ) ) {

        # good to go.
    }
    else {
        carp "couldn't remove the sending directory! at " . $self->dir;
        return 0;
    }

    return 1;

}

sub current_mailouts {

    my $list = shift;
    croak "You did not supply a list "
        if !$list;

    my @mailouts = ();

    my $file;
    opendir( FILES, $DADA::Config::TMP  )
        or croak "$DADA::Config::PROGRAM_NAME $DADA::Config::VER error, can't open $DADA::Config::TMP  to read: $!";

    while ( defined( $file = readdir FILES ) ) {

        #don't read '.' or '..'
        next if $file =~ /^\.\.?$/;

        #next unless -d $file;

        $file =~ s(^.*/)();

#don't read anything that doesn't have an 'mj' in its filename at the beginning.
        next if $file !~ /^sendout\-$list.*$/;

        # Why does this not work?
        #$file =~ s/sendout\-$list//;

        my ( $junk, $list, $listtype, $id ) = split( '-', $file, 4); #limit of, "4"
    
        push( @mailouts, { type => $listtype, id => $id } );

    }

    closedir(FILES);

    return @mailouts;

}

sub mailout_exists {

    my $list = shift;
    my $id   = shift;
    my $type = shift;

    $id =~ s/\@/_at_/g;
    $id =~ s/\>|\<//g;

    croak "You did not supply a list!"
        if !$list;
    croak "You did not supply an id! "
        if !$id;
    croak "You did not supply a type!"
        if !$type;

    my @mailouts = current_mailouts($list);

    foreach my $mo (@mailouts) {

        if ( $mo->{id} eq $id && $mo->{type} eq $type ) {

            return 1;

        }
    }

    return 0;

}

sub _list_name_check {

    my ( $self, $n ) = @_;
    $n = strip($n);
    return 0 if !$n;
    return 0 if $self->_list_exists($n) == 0;
    return 1;
}

sub _list_exists {
    my ( $self, $n ) = @_;
    return DADA::App::Guts::check_if_list_exists( -List => $n );
}




sub DESTROY {

    my $self = shift;

}

1;

=pod

=head1 NAME

DADA::Mail::MailOut - Helps Monitor a Mass Mailout


=head1 VERSION

Refer to the version of Dada Mail that this module comes in. 

=head1 SYNOPSIS

    # A few subroutines, exported by default: 
    
    my @mailouts  = DADA::Mail::MailOut::current_mailouts($list);  
 
    my $exists    = DADA::Mail::MailOut::mailout_exists($list, $id, $type); 
    
 
 
     
    # Create a new DADA::Mail::MailOut object: 
    my $mailout = DADA::Mail::MailOut->new(-List => $list); 
    
    # Make a new Mailout: 
    $mailout->create(
                    -fields   => {%fields},
                    -list_type => 'list',
                    -mh_obj    => $mh_obj,  
               ); 
    
    # how's that mailout doin'?
    my $status = $mailout->status; 
    
    # do I need to reload the mailout? 
    my $yes_restart = $mailout->should_be_restarted; 
    
    # if so, let's do that: 
    if($yes_restart){ 
        $mailout->reload('list');  
    }

=head1 DESCRIPTION

This module does a few things, all of which happen to deal with setting up a
mass mailing and then monitoring its status.

Mass Mailings do take a while and the CGI environment that Dada Mail is run
in, isn't the best thing to be in during a long-running process, like mail
sending to a few thousand of your closest friends.

Because of that, this module attempts to keep close track of how the mailing
is doing and give an option to reload a mailing at the time it stopped.
Mailings usually stop because the mailing process itself can be killed by the server
itself.

The create() method does most of the magic in getting a mailing setup. When
called correctly, it will make a temporary directory (usually in B<$TMP > that
holds within it the following files:

=over

=item * The Temporary Subscriber List

To keep the main subscriber list free for adding/editing/removing/viewing
(especially with the Plaintext Backend), a temporary subscriber list is
created for each mailing.

This subscriber list does not just hold the email address of a subscriber, but
other meta information, like the B<pin> associated with the subscriber,
amongst other things.

See the DADA::MailingList::Subscribers::[..]::create_bulk_sending_file()

http://mojo.skazat.com/support/documentation/MailingList_Subscribers_PlainText.pm.html

method for exactly how this is made.

=item * The Total Amount of Recipients Amount

This file simply holds the total amount of recipients of a given mailing. This
will be different than the amount of subscribers on a list, as the list owner
also will receive a copy of a mailout. There are also some other fringe
reasons for discrepencies, which I won't go into right here.

=item * The Amount Sent Counter

This file will be +1'd everytime an address has been sent to. Note! That this
counter will be added to, regardless of whether the individual email sent was successful.

=item * The, "First Accessed", File

This file just basically holds the time() that a mailout started. 

=item * The, "Last Accessed", File

This file will be updated with what's returned by the time() perl builtin,
every time countsubscriber() is called.

This file is basically used to make sure that a mailing process is still going
on. If the time saved in this file becomes too long, a mailing may become ripe
for a reload().

=item * A Copy of the Message Being Sent Out

A copy of the actual email message source is saved. The message headers can
later be accessed for reporting purposes and the entire message source can be
used if the message has to be reload()ed.

=back

=head1 SUBROUTINES/METHODS

=head2 new

Takes one argument - the list shortname, ala: 

    my $mailout = DADA::Mail::MailOut->new({-List => 'listshortname'}); 

All there is to it. 

B<Note!> that a MailOut object is pretty useless, until you call the, B<create()> method. 

=head2 create

Used to setup, or, "create" a mailout. Makes all the temporary files and directories need. Needs a few things passed - do pay attention, since what it needs is slightly odd: 


 $mailout->create(
                    -fields   => {%fields},
                    -list_type => 'list',
                    -mh_obj    => $mh_obj,  
               ); 

=over

=item * -fields

B<-fields> is your actual mailing list message - the fields themselves are the headers of your message. The Body of the message itself is saved in the, B<Body> key/value. 

This is a fairly odd format to have everything in, but it's sort of native to DADA::Mail::Send and that's the module most likely to be calling B<create()>. 

=item * -list_type

List Type holds which subscription sublist you're sending to. Most likely, this is going to be, B<list>. There are times where it may be, B<black_list>, or, B<invite_list>, etc. 

=item * -mh_obj

B<-mh_obj> should actually be a DADA::Mail::Send object - again, very strange thing to pass to this module, but again, B<create> is usually called within DADA::Mail::Send, so that module basically gives a copy of itself to use. 

=back

You'll most likely never call create() yourself, but that's the jist of it. 

=head2 status

Although you may never call B<create>, calling B<status> may be much more commonplace.

 my $status = $mailout->status; 

or even: 

foreach(keys %{$mailout->status}){ 
    print $_; # or... something...
}

B<status> returns a hashref of various information about your mailout. Best not to call this too many times at once, as it does query all those temporary files we've created. I'll go over what you're most likely going to use:

=over

=item * id

The internal id of your mailout. This will also be, "similar" to the Message-ID of your mailing, the id of your archived message, etc. 

=item * total_sending_out_num

How many messages you're supposed to be sending out. 

=item * total_sent_out

How many messages you've proported to have sent out. 

=item * last_access

The last time basically, "total_sent_out" was last accessed.

=item * first_access

Basically the time() when we create()d the mailout. 

=item * email_fields

Itself holds a hashref of the actual message you're sending out. Good for making reports. 

=item * type

The type of message you're sending (list, black_list, invite_list, etc)

=item * is_batch_locked

Will tell you if basically, the mailout is active and you shouldn't clobber the mail sending by calling reload(). If you B<do> call reload() when this is set to, "1", the module will croak. So... don't. 

=item * percent_done

Just takes a percentage based on how many message you've sent out, with how many message are still left to send out, rounded to the nearest whole number. Again, good for reports, but don't use to know exactly where you are in your mailing. 

=item * process_has_stalled

Let's you know if it's been a while since something has happened - but DO NOT USE to figure out if you should call reload, use B<should_be_restarted> instead. 

=item * should_be_restarted

Will let you know if a mailout should be reloaded. Basically you can do one of these: 

 my $status = $mailout->status; 
 if($status->{should_be_restarted} == 1){ 
 
    $mailout->reload({ reload args... }); 
 }

=back

=head1 DIAGNOSTICS

=head1 BUGS AND LIMITATIONS


Please report problems to the author of this module

=head1 AUTHOR

Justin Simoni 

See: http://mojo.skazat.com/contact

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2006 Justin Simoni All rights reserved. 

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, 
Boston, MA  02111-1307, USA.

=cut