Permalink
Browse files

Initial commit

  • Loading branch information...
0 parents commit e499abc7b12c194f884ea67e7b718115446b5cfe Zbigniew Lukasiak committed Aug 30, 2011
@@ -0,0 +1,25 @@
+name = Courriel::MMS
+author = Zbigniew Lukasiak <zlukasiak@opera.com>
+license = Artistic_2_0
+copyright_holder = Opera Software ASA
+copyright_year = 2011
+version = 0.001
+
+[@Basic]
+[AutoPrereqs]
+[Prereqs]
+[TestRelease]
+[PkgVersion]
+
+[MetaNoIndex]
+directory = t/lib
+directory = examples
+[InstallGuide]
+[MetaJSON]
+[NextRelease]
+format = %-9v %{yyyy-MM-dd}d
+[CheckChangeLog]
+[PodSyntaxTests]
+[PodCoverageTests]
+[KwaliteeTests]
+[PodWeaver]
@@ -0,0 +1,116 @@
+use strict;
+use warnings;
+
+package Courriel::MMS;
+use namespace::autoclean;
+use Moose;
+
+extends 'Courriel';
+
+use XWA::MIME::Util;
+use Class::MOP;
+
+my @subclasses = qw(
+Courriel::MMS::MymtsRu
+Courriel::MMS::TmobileUK
+Courriel::MMS::TmobileUS
+);
+
+
+# --- Class methods ---
+around 'parse' => sub {
+ my $orig = shift;
+ my $self = shift;
+ my $email = $self->$orig( @_ );
+
+ for my $class ( @subclasses ){
+ Class::MOP::load_class( $class );
+ return bless( $email, $class ) if $class->match( $email );
+ }
+ return $email;
+};
+
+# sub parse {
+# my $class = shift;
+# my $email = $class->SUPER::parse( @_ );
+# if ( $email->from =~ /mms\.mymts\.ru/i ){
+# require Courriel::MMS::MymtsRu;
+# return bless( $email, 'Courriel::MMS::MymtsRu' );
+# }
+# return $email;
+# }
+
+# --- Instance methods ---
+
+sub _get_image_parts {
+ my $self = shift;
+ return $self->all_parts_matching(
+ sub {
+ my $part = shift;
+ my $mime = $part->mime_type();
+ return 1 if ($mime =~ 'image/(jpeg|gif|png)');
+ return;
+ }
+ );
+}
+
+sub get_mms_images {
+ my $self = shift;
+ my @result;
+ for my $part ( $self->_get_image_parts ){
+ my $name = $part->filename
+ // $part->disposition->get_attribute( 'name' )
+ // $part->content_type->get_attribute( 'name' )
+ // create_random_image_name( $part->mime_type );
+ push @result, [ $name, $part->content ];
+ }
+ return @result;
+
+}
+
+# --- Functions ---
+
+sub create_random_image_name {
+ my ($mime_type) = @_;
+ my $mime_util = XWA::MIME::Util->new();
+ my $suffix = $mime_util->get_extension($mime_type, {must_be_media => "image"});
+ my @r = ("A" .. "Z", "a" .. "z", 1 .. 9);
+ my $filename = join q{}, map { $r[ rand @r ] } (1 .. 8);
+
+ return join q{.} => ($filename, $suffix);
+}
+
+__PACKAGE__->meta()->make_immutable();
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Courriel::MMS - L<Courriel> extension for dealing with MMS messages
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 CLASS METHODS
+
+=head1 INSTANCE METHODS
+
+=head2 C<get_mms_images>
+
+=head1 SEE ALSO
+
+=head2 L<<< Courriel >>>
+
+=head1 AUTHOR
+
+Zbigniew Łukasiak, E<lt>zlukasiak@opera.comE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c), 2011 Opera Software ASA.
+All rights reserved.
@@ -0,0 +1,65 @@
+use strict;
+use warnings;
+
+package Courriel::MMS::MymtsRu;
+use namespace::autoclean;
+use Moose;
+
+extends 'Courriel::MMS';
+
+# --- Class methods ---
+
+sub match {
+ my( $class, $email ) = @_;
+
+ return 1 if $email->from =~ /mms\.mymts\.ru/i;
+ return;
+}
+
+# --- Instance methods ---
+
+around '_get_image_parts' => sub {
+ my $orig = shift;
+ my $self = shift;
+ my @images;
+ for my $image ( $self->$orig( @_ ) ){
+ my $content_id = $image->headers()->get( 'Content-ID' );
+ push @images, $image if !defined( $content_id ) || $content_id !~ /mts_logo/;
+ }
+ return @images;
+};
+
+__PACKAGE__->meta()->make_immutable();
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Courriel::MMS::MymtsRu - L<Courriel> extension for dealing with MMS messages from mms.mymts.ru
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 CLASS METHODS
+
+=head1 INSTANCE METHODS
+
+=head2 C<get_mms_images>
+
+=head1 SEE ALSO
+
+=head2 L<<< Courriel >>>
+
+=head1 AUTHOR
+
+Zbigniew Łukasiak, E<lt>zlukasiak@opera.comE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c), 2011 Opera Software ASA.
+All rights reserved.
@@ -0,0 +1,120 @@
+use strict;
+use warnings;
+
+package Courriel::MMS::TmobileUK;
+use namespace::autoclean;
+use Moose;
+use WWW::Mechanize;
+
+extends 'Courriel::MMS';
+
+use constant DEBUG => 0;
+
+# --- Class methods ---
+
+sub match {
+ my $class = shift;
+ my $email = shift;
+
+ return 1 if $email->from =~ /pm\.sprint\.com//;
+ return;
+}
+
+
+# --- Instance methods ---
+
+# this should really override the ->content method on $self->text_body_part
+# but how to do that elegantly?
+#
+sub text_content {
+ my $self = shift;
+
+ my $html = $self->html_body_part->content;
+
+ my ($body) = $html->[0] =~ m#<tr>\s+<td><pre[^>]+>(.*?)</pre></td>\s+</tr>#gs;
+ return $body;
+}
+
+
+override 'get_mms_images' => sub {
+ my $self = shift;
+
+ my @images;
+ my $html = $self->html_body_part->content;
+ my ( $view_url ) = $html =~ m#<a.*?href="([^"]+)"[^>]*>View (Picture|Slideshow)</a>#;
+ $view_url =~ s/&amp;/&/g;
+
+ my $mech = WWW::Mechanize->new();
+ $mech->agent_alias( 'Windows IE 6' );
+ warn "mechanizing $view_url" if DEBUG;
+ $mech->get( $view_url ); # fetch this page to get session cookies
+
+ if( $mech->success && $mech->ct eq 'text/html' && $mech->content =~ /mediaURL_list/ ) {
+ my $content = $mech->content;
+ while( $content =~ s/mediaURL_list\[(\d+)\]\s=\s"([^"]+)";// ) {
+ my $id = $1; my $image_url = $2;
+ $image_url =~ s/(.*?partExt=\.jpg).*$/$1/;
+
+ next if $content !~ /mediaTYPE_list\[$id\]\s=\s"image";/;
+
+ warn "mechanizing images; $image_url" if DEBUG;
+ $mech->get( $image_url );
+
+ if( $mech->success && $mech->ct =~ m#image/jpe?g# ) {
+ warn "adding image$id.jpg, bytes: ". length( $mech->content ) if DEBUG;
+ push @images, [ 'image'.$id.'.jpg' => $mech->content ];
+ }
+ }
+ }
+ elsif( $mech->success ) {
+ my ( $image_url ) = $html =~ m#<td align="center">\s+<img src="(http://[^"]+)"/>\s+</td>#gs; # this is the thumbnail.
+ $image_url =~ s/^(.*?inviteToken=[a-zA-Z0-9]+).*$/$1/;
+
+ warn "mechanizing image; $image_url" if DEBUG;
+ $mech->get( $image_url ); # get the actual picture (can't use mechanize's follow_link stuff since the image is in a popup)
+
+ if( $mech->success && $mech->ct =~ m#^image/jpe?g# ) {
+ push @images [ 'image.jpg' => $mech->content ];
+ }
+ }
+
+ return @images;
+}
+
+
+};
+
+__PACKAGE__->meta()->make_immutable();
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Courriel::MMS::TmobileUK - L<Courriel> extension for dealing with MMS messages from T-mobile UK
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 CLASS METHODS
+
+=head1 INSTANCE METHODS
+
+=head2 C<get_mms_images>
+
+=head1 SEE ALSO
+
+=head2 L<<< Courriel >>>
+
+=head1 AUTHOR
+
+Zbigniew Łukasiak, E<lt>zlukasiak@opera.comE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c), 2011 Opera Software ASA.
+All rights reserved.
@@ -0,0 +1,63 @@
+use strict;
+use warnings;
+
+package Courriel::MMS::TmobileUK;
+use namespace::autoclean;
+use Moose;
+
+extends 'Courriel::MMS';
+
+# --- Class methods ---
+
+sub match {
+ my $class = shift;
+ my $email = shift;
+
+ return 1 if $email->from =~ /mmsreply\.t-mobile\.co\.uk/;
+ return;
+}
+
+
+# --- Instance methods ---
+
+around 'get_mms_images' => sub {
+ my $orig = shift;
+ my $self = shift;
+
+ return grep { $_->[0] !~ /^logo.gif$/ } $self->$orig( @_ );
+};
+
+__PACKAGE__->meta()->make_immutable();
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Courriel::MMS::TmobileUK - L<Courriel> extension for dealing with MMS messages from T-mobile UK
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 CLASS METHODS
+
+=head1 INSTANCE METHODS
+
+=head2 C<get_mms_images>
+
+=head1 SEE ALSO
+
+=head2 L<<< Courriel >>>
+
+=head1 AUTHOR
+
+Zbigniew Łukasiak, E<lt>zlukasiak@opera.comE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c), 2011 Opera Software ASA.
+All rights reserved.
Oops, something went wrong.

0 comments on commit e499abc

Please sign in to comment.