home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _efa3ee0e3c6deb89cc915eefcfe801bc < prev    next >
Encoding:
Text File  |  2004-06-01  |  3.7 KB  |  121 lines
  1. # ======================================================================
  2. #
  3. # Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com)
  4. # SOAP::Lite is free software; you can redistribute it
  5. # and/or modify it under the same terms as Perl itself.
  6. #
  7. # $Id: POP3.pm,v 1.3 2001/08/11 19:09:57 paulk Exp $
  8. #
  9. # ======================================================================
  10.  
  11. package SOAP::Transport::POP3;
  12.  
  13. use strict;
  14. use vars qw($VERSION);
  15. $VERSION = sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/);
  16.  
  17. use Net::POP3; 
  18. use URI; 
  19. use SOAP::Lite;
  20.  
  21. # ======================================================================
  22.  
  23. package SOAP::Transport::POP3::Server;
  24.  
  25. use Carp ();
  26. use vars qw(@ISA $AUTOLOAD);
  27. @ISA = qw(SOAP::Server);
  28.  
  29. sub DESTROY { my $self = shift; $self->quit if $self->{_pop3server} }
  30.  
  31. sub new {
  32.   my $self = shift;
  33.     
  34.   unless (ref $self) {
  35.     my $class = ref($self) || $self;
  36.     my $address = shift;
  37.     Carp::carp "URLs without 'pop://' scheme are deprecated. Still continue" 
  38.       if $address =~ s!^(pop://)?!pop://!i && !$1;
  39.     my $server = URI->new($address);
  40.     $self = $class->SUPER::new(@_);
  41.     $self->{_pop3server} = Net::POP3->new($server->host_port) or Carp::croak "Can't connect to '@{[$server->host_port]}': $!";
  42.     my $method = !$server->auth || $server->auth eq '*' ? 'login' : 
  43.                   $server->auth eq '+APOP' ? 'apop' : 
  44.                   Carp::croak "Unsupported authentication scheme '@{[$server->auth]}'";
  45.     $self->{_pop3server}->$method(split /:/, $server->user) or Carp::croak "Can't authenticate to '@{[$server->host_port]}' with '$method' method"
  46.       if defined $server->user;
  47.   }
  48.   return $self;
  49. }
  50.  
  51. sub AUTOLOAD {
  52.   my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
  53.   return if $method eq 'DESTROY';
  54.  
  55.   no strict 'refs';
  56.   *$AUTOLOAD = sub { shift->{_pop3server}->$method(@_) };
  57.   goto &$AUTOLOAD;
  58. }
  59.  
  60. sub handle {
  61.   my $self = shift->new;
  62.   my $messages = $self->list or return;
  63.   foreach my $msgid (keys %$messages) {
  64.     $self->SUPER::handle(join '', @{$self->get($msgid)});
  65.   } continue {
  66.     $self->delete($msgid);
  67.   }
  68.   return scalar keys %$messages;
  69. }
  70.  
  71. sub make_fault { return }
  72.  
  73. # ======================================================================
  74.  
  75. 1;
  76.  
  77. __END__
  78.  
  79. =head1 NAME
  80.  
  81. SOAP::Transport::POP3 - Server side POP3 support for SOAP::Lite
  82.  
  83. =head1 SYNOPSIS
  84.  
  85.   use SOAP::Transport::POP3;
  86.  
  87.   my $server = SOAP::Transport::POP3::Server
  88.     -> new('pop://pop.mail.server')
  89.     # if you want to have all in one place
  90.     # -> new('pop://user:password@pop.mail.server') 
  91.     # or, if you have server that supports MD5 protected passwords
  92.     # -> new('pop://user:password;AUTH=+APOP@pop.mail.server') 
  93.     # specify list of objects-by-reference here 
  94.     -> objects_by_reference(qw(My::PersistentIterator My::SessionIterator My::Chat))
  95.     # specify path to My/Examples.pm here
  96.     -> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method') 
  97.   ;
  98.   # you don't need to use next line if you specified your password in new()
  99.   $server->login('user' => 'password') or die "Can't authenticate to POP3 server\n";
  100.  
  101.   # handle will return number of processed mails
  102.   # you can organize loop if you want
  103.   do { $server->handle } while sleep 10;
  104.  
  105.   # you may also call $server->quit explicitly to purge deleted messages
  106.  
  107. =head1 DESCRIPTION
  108.  
  109. =head1 COPYRIGHT
  110.  
  111. Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
  112.  
  113. This library is free software; you can redistribute it and/or modify
  114. it under the same terms as Perl itself.
  115.  
  116. =head1 AUTHOR
  117.  
  118. Paul Kulchenko (paulclinger@yahoo.com)
  119.  
  120. =cut
  121.