Mail::Box::IMAP4::SSL

package Mail::Box::IMAP4::SSL;
use 5.006;
use strict;
use warnings;

use base 'Mail::Box::IMAP4';
use IO::Socket::SSL qw();
use Mail::Reporter qw();
use Mail::Transport::IMAP4 qw();

our $VERSION = '0.02'; 

my $imaps_port = 993; # standard port for IMAP over SSL

#--------------------------------------------------------------------------#
# init
#--------------------------------------------------------------------------#

sub init {
    my ($self, $args) = @_;

    # until we're connected, mark as closed in case we exit early
    # (otherwise, Mail::Box::DESTROY will try to close/unlock, which dies)
    $self->{MB_is_closed}++;

    # if no port is provided, use the default
    $args->{server_port} ||= $imaps_port;

    # Mail::Box::IMAP4 wants a folder or it throws warnings
    $args->{folder} ||= '/';

    # Use messages classes from our superclass type
    $args->{message_type} ||= 'Mail::Box::IMAP4::Message';

    # giving us a transport argument is an error since our only purpose
    # is to create the right kind of transport object
    if ( $args->{transporter} ) {
        Mail::Reporter->log(ERROR => 
            "The 'transporter' option is not valid for " . __PACKAGE__
        );
        return;
    }

    # some arguments are required to connect to a server
    for my $req ( qw/ server_name username password/ ) {
        if ( not defined $args->{$req} ) {
            Mail::Reporter->log(ERROR =>  
                "The '$req' option is required for " . __PACKAGE__ 
            );
            return;
        }
    }

    # trying to create the transport object

    my $ssl_socket = IO::Socket::SSL->new(  
        Proto    => 'tcp',
        PeerAddr => $args->{server_name},
        PeerPort => $args->{server_port},   
    );
    
    unless ( $ssl_socket ) {
        Mail::Reporter->log(ERROR => 
            "Couldn't connect to '$args->{server_name}': " 
            . IO::Socket::SSL::errstr()
        );
        return;
    }

    my $imap = Mail::IMAPClient->new( 
        User     => $args->{username},
        Password => $args->{password},
        Socket   => $ssl_socket,
        Uid      => 1,              # Mail::Transport::IMAP4 does this
        Peek     => 1,              # Mail::Transport::IMAP4 does this
    );
    my $imap_err = $@;
        
    unless ( $imap && $imap->IsAuthenticated ) {
        Mail::Reporter->log( ERROR => 
            "Login rejected for user '$args->{username}'"
            . " on server '$args->{server_name}': $imap_err"
        );
        return;
    }

    $args->{transporter} = Mail::Transport::IMAP4->new(
        imap_client => $imap,
    );
        
    unless ( $args->{transporter} ) {
        Mail::Reporter->log( ERROR => 
            "Error creating Mail::Transport::IMAP4 from the SSL connection."
        );
        return;
    }
    
    # now that we have a valid transporter, mark ourselves open
    # and let the superclass take over
    delete $self->{MB_is_closed};
    return $self->SUPER::init($args); 
}

1; #modules must return true

__END__

#--------------------------------------------------------------------------#
# pod documentation 
#--------------------------------------------------------------------------#