From 2b02f055f92457a5e12695ca1baad196bb81acd3 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sun, 9 Apr 2006 15:14:07 +0000 Subject: [PATCH] added new mail retrieval subsystemm --- docs/changelog/6.x.x.txt | 1 + docs/gotcha.txt | 2 + lib/WebGUI/Mail/Get.pm | 197 +++++++++++++++++++++++++++++++++ lib/WebGUI/Mail/Send.pm | 3 +- lib/WebGUI/Session/DateTime.pm | 46 ++++++++ sbin/testEnvironment.pl | 2 + 6 files changed, 250 insertions(+), 1 deletion(-) create mode 100644 lib/WebGUI/Mail/Get.pm diff --git a/docs/changelog/6.x.x.txt b/docs/changelog/6.x.x.txt index 8c89d9531..993ac70fb 100644 --- a/docs/changelog/6.x.x.txt +++ b/docs/changelog/6.x.x.txt @@ -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) diff --git a/docs/gotcha.txt b/docs/gotcha.txt index bf67b4026..7f1d76745 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -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. diff --git a/lib/WebGUI/Mail/Get.pm b/lib/WebGUI/Mail/Get.pm new file mode 100644 index 000000000..9e1cfa4c1 --- /dev/null +++ b/lib/WebGUI/Mail/Get.pm @@ -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 , 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; diff --git a/lib/WebGUI/Mail/Send.pm b/lib/WebGUI/Mail/Send.pm index a45ee713b..b7b5875b9 100644 --- a/lib/WebGUI/Mail/Send.pm +++ b/lib/WebGUI/Mail/Send.pm @@ -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; } diff --git a/lib/WebGUI/Session/DateTime.pm b/lib/WebGUI/Session/DateTime.pm index 5ad9925de..3cbc2cf3d 100644 --- a/lib/WebGUI/Session/DateTime.pm +++ b/lib/WebGUI/Session/DateTime.pm @@ -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). diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 45dc17cd6..cdb3ae430 100644 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -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);