view release on metacpan or  search on metacpan

lib/Authen/Simple/IMAP.pm  view on Meta::CPAN

our $VERSION = '0.1.2';

__PACKAGE__->options({
	host => {
		type     => Params::Validate::SCALAR,
		optional => 1,
		depends  => [ 'protocol' ],
	},
	protocol => {
		type     => Params::Validate::SCALAR,
		default  => 'IMAP',
		optional => 1,
		depends  => [ 'host' ],
	},
	imap => {
		type     => Params::Validate::OBJECT,
		can		 => ['login','errstr'],
		optional => 1,
	},
	timeout => {
		type 	=> Params::Validate::SCALAR,
		optional => 1,
	},
	escape_slash => {
		type 	 => Params::Validate::SCALAR,
		optional => 1,
		default  => 1,
	},
});

sub init {
	my ($self, $args) = @_;
	if ( $args->{log} ) {
		$self->log($args->{log});
	}
	$self->log->info("Starting init routine for Authen::Simple::IMAP");
	$self->log->debug("Starting init routine\n") if $self->log;
	my $is_user_provided_object;
	my @imap_args = $args->{host};
	if ( defined($args->{timeout}) ) {
		push(@imap_args, timeout => $args->{timeout});
	}
	if ( defined($args->{imap}) ) {
		$self->log->info("setting up with user provided IMAP object ".
			ref($args->{imap})."\n") if $self->log;
		$is_user_provided_object = 1;
	}
	elsif ( $args->{protocol} eq 'IMAPS' ) {
		require Net::IMAP::Simple::SSL;
	}
	elsif ( $args->{protocol} eq 'IMAP' ) {
		require Net::IMAP::Simple;
	}
	elsif ( defined($args->{protocol}) ) {
		croak "Valid protocols are 'IMAP' and 'IMAPS', not '".$args->{protocol}."'";
	}
	else { 
		croak "A protocol or an imap object is required";
	}
	my $obj = $self->SUPER::init($args);
	$obj->{imap_args} = \@imap_args;
	if ( $is_user_provided_object ) {
		$obj->{user_provided_object} = $args->{imap};
	}
	return $obj;
}

sub connect {
	my $self = shift;
	die 'Should never happen' if !defined($self->{imap_args});
	if ( $self->{user_provided_object} ) {
		$self->{imap} = $self->{user_provided_object};
		return;
	}
	my @imap_args = @{$self->{imap_args}};
	#warn 'imap args  '.join(", ",@imap_args)."\n";
	my $host = shift(@imap_args);
	my $args = { @imap_args };
	unshift(@imap_args,$host);

	local( $SIG{ALRM} ) = sub { croak "timeout while connecting to server" };
	if ( defined($args->{timeout}) ) {	
		alarm $args->{timeout};
	}
	else {
		alarm 90;
	}
	if ( defined($self->{imap}) ) {
		$self->log->info("already have a user provided IMAP object ".
			ref($self->{imap})."\n") if $self->log;
	}
	elsif ( $self->{protocol} eq 'IMAPS' ) {
		local( $SIG{ALRM} ) = sub { 
			croak "timeout while connecting to IMAPS server at $host" 
		};
		$self->log->info("connecting to ".$host." with IMAPS\n")
			 if $self->log;
		$self->{imap} = Net::IMAP::Simple::SSL->new(@imap_args) ||
			die "Unable to connect to IMAPS: $Net::IMAP::Simple::SSL::errstr\n";
	}
	elsif ( $self->{protocol} eq 'IMAP' ) {
		local( $SIG{ALRM} ) = sub { 
			croak "timeout while connecting to IMAP server at $host" 
		};
		$self->log->info("connecting to ".$host." with IMAP (no SSL)\n")
			 if $self->log;
		$self->{imap} = Net::IMAP::Simple->new(@imap_args) ||
			die "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
	}
	else { 
		croak 'This should never happen!';
	}
	alarm 0;
	return $self->{imap};
}


sub check {
	my @params = validate_pos(@_,
		{