added new mail retrieval subsystemm
This commit is contained in:
JT Smith
parent
c0225f6b35
commit
2b02f055f9
6 changed files with 250 additions and 1 deletions
|
|
@ -32,6 +32,7 @@
|
|||
everything should cache in the same way.
|
||||
- Converted WebGUI to use a new object oriented session system. More details
|
||||
in migation.txt.
|
||||
- Added an API for retrieving email from POP3 servers.
|
||||
- Added a lot more tests to the test suite.
|
||||
- Added a new pluggable templating system. (Thanks to Misja Op de Coul /
|
||||
E-Wise)
|
||||
|
|
|
|||
|
|
@ -40,6 +40,8 @@ save you many hours of grief.
|
|||
POE::Component::IKC::Server
|
||||
POE::Component::Client::UserAgent
|
||||
Net::Subnets
|
||||
DateTime::Format::Mail
|
||||
Net::POP3
|
||||
|
||||
* The upgrade script is going to convert your WebGUI config files
|
||||
from the current PlainConfig format to the new JSON format.
|
||||
|
|
|
|||
197
lib/WebGUI/Mail/Get.pm
Normal file
197
lib/WebGUI/Mail/Get.pm
Normal file
|
|
@ -0,0 +1,197 @@
|
|||
package WebGUI::Mail::Get;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2006 Plain Black Corporation.
|
||||
-------------------------------------------------------------------
|
||||
Please read the legal notices (docs/legal.txt) and the license
|
||||
(docs/license.txt) that came with this distribution before using
|
||||
this software.
|
||||
-------------------------------------------------------------------
|
||||
http://www.plainblack.com info@plainblack.com
|
||||
-------------------------------------------------------------------
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use Net::POP3;
|
||||
use MIME::Entity;
|
||||
use MIME::Parser;
|
||||
use LWP::MediaTypes qw(guess_media_type);
|
||||
use WebGUI::Group;
|
||||
use WebGUI::User;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Package WebGUI::Mail::Get
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package is used for retrieving emails via POP3.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Mail::Get;
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
These methods are available from this class:
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 connect ( sessionh, params )
|
||||
|
||||
Constructor. Opens a connection to a POP3 server.
|
||||
|
||||
=head3 session
|
||||
|
||||
A reference to the current session.
|
||||
|
||||
=head3 params
|
||||
|
||||
A hash reference containing POP3 connection properties.
|
||||
|
||||
=head4 server
|
||||
|
||||
A scalar containing an IP address or host name of the server to connect to.
|
||||
|
||||
=head4 account
|
||||
|
||||
The account name to use to connect to this POP3 server.
|
||||
|
||||
=head4 password
|
||||
|
||||
The password to use to connect to this POP3 server.
|
||||
|
||||
=cut
|
||||
|
||||
sub connect {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $params = shift;
|
||||
my $pop = Net::POP3->new($params->{server}, Timeout => 60);
|
||||
unless (defined $pop) {
|
||||
$session->errorHandler->error("Couldn't connect to POP3 server ". $params->{server});
|
||||
return undef;
|
||||
}
|
||||
unless ($pop->login($params->{account}, $params->{password})) {
|
||||
$session->errorHandler->error("Couldn't log in to POP3 server ".$params->{server}." as ".$params->{account});
|
||||
return undef;
|
||||
}
|
||||
my $messageNumbers = $pop->list;
|
||||
my @ids = ();
|
||||
foreach my $key (keys %{$messageNumbers}) {
|
||||
push(@ids, $key);
|
||||
}
|
||||
bless {_pop=>$pop, _session=>$session, _ids=>\@ids }, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 disconnect ( )
|
||||
|
||||
Disconnects from the POP3 server.
|
||||
|
||||
=cut
|
||||
|
||||
sub disconnect {
|
||||
my $self = shift;
|
||||
$self->{_pop}->quit;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getNextMessage ( )
|
||||
|
||||
Retrieves the next available message from the server. Returns undef if there are no more messages. Returns a hash reference containing the properties of the message. Here's an example:
|
||||
|
||||
{
|
||||
to => 'John Doe <jon@example.com>, jane@example.com',
|
||||
from => 'sam@example.com',
|
||||
cc => 'joe@example.com',
|
||||
subject => 'This is my message subject',
|
||||
inReplyTo => 'some-message-id',
|
||||
date => 1144536119,
|
||||
parts => [
|
||||
{
|
||||
type=>'text/plain',
|
||||
content=>'Some body text goes here',
|
||||
filename => undef
|
||||
}, {
|
||||
type=>'image/png',
|
||||
content=>' ---- binary content here ---- ',
|
||||
filename => 'image.png'
|
||||
}, {
|
||||
type=>'application/msword',
|
||||
content=>' ---- binary content here ---- ',
|
||||
filename => undef
|
||||
}
|
||||
]
|
||||
}
|
||||
|
||||
=cut
|
||||
|
||||
sub getNextMessage {
|
||||
my $self = shift;
|
||||
my $id = pop(@{$self->{_ids}});
|
||||
return undef unless $id;
|
||||
my $rawMessage = $self->{_pop}->get($id);
|
||||
my $parser = MIME::Parser->new;
|
||||
$parser->output_to_core(1);
|
||||
my $parsedMessage = $parser->parse_data($rawMessage);
|
||||
if (defined $parsedMessage) {
|
||||
$self->{_pop}->delete($id);
|
||||
} else {
|
||||
$self->session->errorHandler->error("Could not parse POP3 message $id");
|
||||
return undef;
|
||||
}
|
||||
my $head = $parsedMessage->head;
|
||||
my %data = (
|
||||
to => $head->get("To") || undef,
|
||||
from => $head->get("From") || undef,
|
||||
cc => $head->get("Cc") || undef,
|
||||
subject => $head->get("Subject") || undef,
|
||||
inReplyTo => $head->get("In-Reply-To") || undef,
|
||||
date => $self->session->datetime->mailToEpoch($head->get("Date")),
|
||||
);
|
||||
my @segments = ();
|
||||
my @parts = $parsedMessage->parts;
|
||||
push(@parts, $parsedMessage) unless (@parts); # deal with the fact that there might be only one part
|
||||
foreach my $part (@parts) {
|
||||
my $type = $part->mime_type;
|
||||
next if ($type eq "message/rfc822");
|
||||
my $body = $part->bodyhandle;
|
||||
my $disposition = $part->head->get("Content-Disposition");
|
||||
$disposition =~ m/filename=\"(.*)\"/;
|
||||
my $filename = $1;
|
||||
my $content = $body->as_string if (defined $body);
|
||||
next unless ($content);
|
||||
push(@segments, {
|
||||
filename=>$filename,
|
||||
type=>$type,
|
||||
content=>$content
|
||||
});
|
||||
}
|
||||
$data{parts} = \@segments;
|
||||
return \%data;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 session ( )
|
||||
|
||||
Returns a reference to the current session.
|
||||
|
||||
=cut
|
||||
|
||||
sub session {
|
||||
my $self = shift;
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -201,6 +201,7 @@ sub create {
|
|||
Bcc=>$headers->{bcc},
|
||||
"Reply-To"=>$headers->{replyTo},
|
||||
Subject=>$headers->{subject},
|
||||
"Message-Id"=>$headers->{messageId} || "WebGUI-".$session->id->generate,
|
||||
Date=>$session->datetime->epochToHuman("","%W, %d %C %y %j:%n:%s %O"),
|
||||
"X-Mailer"=>"WebGUI"
|
||||
);
|
||||
|
|
@ -275,7 +276,7 @@ sub retrieve {
|
|||
$session->db->deleteRow("mailQueue","messageId", $messageId);
|
||||
my $parser = MIME::Parser->new;
|
||||
$parser->output_to_core(1);
|
||||
bless {_session=>$session, _message=>$parser->parse_data($data->{messageId}), _toGroup=>$data->{toGroup}}, $class;
|
||||
bless {_session=>$session, _message=>$parser->parse_data($data->{message}), _toGroup=>$data->{toGroup}}, $class;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ use strict;
|
|||
|
||||
use DateTime;
|
||||
use DateTime::Format::Strptime;
|
||||
use DateTime::Format::Mail;
|
||||
use DateTime::TimeZone;
|
||||
use Tie::IxHash;
|
||||
use WebGUI::International;
|
||||
|
|
@ -275,6 +276,26 @@ sub epochToHuman {
|
|||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 epochToMail ( [ epoch ] )
|
||||
|
||||
Formats an epoch date as an RFC2822/822 date, which is what is used in SMTP emails.
|
||||
|
||||
=head3 epoch
|
||||
|
||||
The date to format. Defaults to now.
|
||||
|
||||
=cut
|
||||
|
||||
sub epochToMail {
|
||||
my $self = shift;
|
||||
my $epoch = shift || time();
|
||||
my $timeZone = $self->session->user->profileField("timeZone") || "America/Chicago";
|
||||
my $dt = DateTime->from_epoch( epoch =>$epoch, time_zone=>$timeZone);
|
||||
return DateTime::Format::Mail->format_datetime($dt);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 epochToSet ( epoch, withTime )
|
||||
|
||||
Returns a set date (used by WebGUI::HTMLForm->date) in the format of YYYY-MM-DD.
|
||||
|
|
@ -566,6 +587,31 @@ sub localtime {
|
|||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 mailToEpoch ( [ date ] )
|
||||
|
||||
Converts a mail formatted date into an epoch.
|
||||
|
||||
=head3 date
|
||||
|
||||
A date formatted according to RFC2822/822.
|
||||
|
||||
=cut
|
||||
|
||||
sub mailToEpoch {
|
||||
my $self = shift;
|
||||
my $mail = shift;
|
||||
my $parser = DateTime::Format::Mail->new->loose;
|
||||
my $dt = eval { $parser->parse_datetime($mail)};
|
||||
if ($@) {
|
||||
$self->session->errorHandler->warn($mail." is not a vaild date for email, and is so poorly formatted, we can't even guess what it is.");
|
||||
return undef;
|
||||
}
|
||||
return $dt->epoch;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 monthCount ( startEpoch, endEpoch )
|
||||
|
||||
Returns the number of months between the start and end dates (inclusive).
|
||||
|
|
|
|||
|
|
@ -60,6 +60,7 @@ checkModule("IO::Zlib",1.01);
|
|||
checkModule("Compress::Zlib",1.34);
|
||||
checkModule("Net::SMTP",2.24);
|
||||
checkModule("MIME::Tools",5.419);
|
||||
checkModule("Net::POP3",2.28);
|
||||
checkModule("Tie::IxHash",1.21);
|
||||
checkModule("Tie::CPHash",1.001);
|
||||
checkModule("XML::Simple",2.09);
|
||||
|
|
@ -68,6 +69,7 @@ checkModule("DateTime",0.2901);
|
|||
checkModule("Time::HiRes",1.38);
|
||||
checkModule("DateTime::Format::Strptime",1.0601);
|
||||
checkModule("DateTime::Cron::Simple",0.2);
|
||||
checkModule("DateTime::Format::Mail",0.2901);
|
||||
checkModule("Image::Magick",6.0);
|
||||
checkModule("Log::Log4perl",0.51);
|
||||
checkModule("Net::LDAP",0.25);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue