package Mail::Webmail::Gmail; use lib qw(lib); use strict; require LWP::UserAgent; require HTTP::Headers; require HTTP::Cookies; require HTTP::Request::Common; require Crypt::SSLeay; require Exporter; our $VERSION = "1.02"; our @ISA = qw(Exporter); our @EXPORT_OK = (); our @EXPORT = (); our $USER_AGENT = "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7) Gecko/20040626 Firefox/0.8"; our $MAIL_URL = "http://gmail.google.com/gmail"; our $SSL_MAIL_URL = "https://gmail.google.com/gmail"; our $LOGIN_URL = "https://www.google.com/accounts/ServiceLoginBoxAuth?service=mail&continue=http://gmail.google.com/gmail"; our %FOLDERS = ( 'INBOX' => '^I', 'STARRED' => '^T', 'SPAM' => '^S', 'TRASH' => '^K', ); sub new { my $class = shift; my %args = @_; my $ua = new LWP::UserAgent( agent => $USER_AGENT, keep_alive => 1 ); push( @LWP::Protocol::http::EXTRA_SOCK_OPTS, SendTE => 0 ); my $self = bless { _username => $args{username} || die( 'No username defined' ), _password => $args{password} || die( 'No password defined' ), _login_url => $args{login_server} || $LOGIN_URL, _mail_url => $args{mail_server} || $args{encrypt_session} ? $SSL_MAIL_URL : $MAIL_URL, _proxy_user => $args{proxy_username}|| '', _proxy_pass => $args{proxy_password}|| '', _proxy_name => $args{proxy_name} || '', _logged_in => 0, _err_str => '', _cookies => { }, _ua => $ua, _debug_level => 0, _error => 0, }, $class; if ( defined( $args{proxy_name} ) ) { $self->{_proxy_enable}++; if ( defined( $args{proxy_username} ) && defined( $args{proxy_password} ) ) { $self->{_proxy_enable}++; } } return $self; } sub error { my ( $self ) = @_; return( $self->{_error} ); } sub error_msg { my ( $self ) = @_; my $error_msg = $self->{_err_str}; $self->{_error} = 0; $self->{_err_str} = ''; return( $error_msg ); } sub login { my ( $self ) = @_; return 0 if $self->{_logged_in}; if ( $self->{_proxy_enable} && $self->{_proxy_enable} >= 1 ) { $ENV{HTTPS_PROXY} = $self->{_proxy_name}; if ( $self->{_proxy_enable} && $self->{_proxy_enable} >= 2 ) { $ENV{HTTPS_PROXY_USERNAME} = $self->{_proxy_user}; $ENV{HTTPS_PROXY_PASSWORD} = $self->{_proxy_pass}; } } my $req = HTTP::Request->new( POST => $self->{_login_url} ); my ( $cookie ); $req->content_type( "application/x-www-form-urlencoded" ); $req->content( 'Email=' . $self->{_username} . '&Passwd=' . $self->{_password} . '&null=Sign%20in' ); my $res = $self->{_ua}->request( $req ); if ( $res->is_success() ) { update_tokens( $self, $res ); if ( $res->content() =~ /top.location = "(.*)";/ ) { $req = HTTP::Request->new( GET => "https://www.google.com/accounts/$1" ); $req->header( 'Cookie' => $self->{_cookie} ); $res = $self->{_ua}->request( $req ); if ( $res->content() =~ /location.replace\("(.*)"\)/ ) { update_tokens( $self, $res ); $req = HTTP::Request->new( GET => $1 ); $req->header( 'Cookie' => $self->{_cookie} ); $res = $self->{_ua}->request( $req ); if ( $res->content() =~ / =head1 SAMPLE TEST SCRIPTS below is a listing of some of the tests that I use as I test various features SAMPLE USAGE my ( $gmail ) = Mail::Webmail::Gmail->new( username => 'username', password => 'password', ); ### Test Sending Message #### my $msgid = $gmail->send_message( to => 'testuser@test.com', subject => time(), msgbody => 'Test' ); print "Msgid: $msgid\n"; if ( $msgid ) { if ( $gmail->error() ) { print $gmail->error_msg(); } else { ### Create new label ### my $test_label = "tl_" . time(); $gmail->edit_labels( label => $test_label, action => 'create' ); if ( $gmail->error() ) { print $gmail->error_msg(); } else { ### Add this label to our new message ### $gmail->edit_labels( label => $test_label, action => 'add', 'msgid' => $msgid ); if ( $gmail->error() ) { print $gmail->error_msg(); } else { print "Added label: $test_label to message $msgid\n"; } } } } ### ### Move message to trash ### my $msgid = $gmail->send_message( to => 'testuser@test.com', subject => "del_" . time(), msgbody => 'Test Delete' ); if ( $gmail->error() ) { print $gmail->error_msg(); } else { $gmail->delete_message( msgid => $msgid, del_message => 0 ); if ( $gmail->error() ) { print $gmail->error_msg(); } else { print "MSG: $msgid moved to trash\n"; } } ### ### Delete all SPAM folder messages ### my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmail::FOLDERS{ 'SPAM' } ); if ( @{ $messages } ) { my @msgids; foreach ( @{ $messages } ) { push( @msgids, $_->{ 'id' } ); } $gmail->delete_message( msgid => \@msgids, search => 'spam', del_message => 1 ); if ( $gmail->error() ) { print $gmail->error_msg(); } else { print "Deleted " . @msgids . " Messages\n"; } } ### ### Print out all user defined labels my @labels = $gmail->get_labels(); foreach ( @labels ) { print "Label: '" . $_ . "'\n"; } ### ### Prints out new messages attached to the first label my @labels = $gmail->get_labels(); my $messages = $gmail->get_messages( label => $labels[0] ); if ( defined( $messages ) ) { foreach ( @{ $messages } ) { if ( $_->{ 'new' } ) { print "Subject: " . $_->{ 'subject' } . " / Blurb: " . $_->{ 'blurb' } . "\n"; } } } ### ### Prints out all attachments my $messages = $gmail->get_messages(); foreach ( @{ $messages } ) { my $email = $gmail->get_indv_email( msg => $_ ); if ( defined( $email->{ $_->{ 'id' } }->{ 'attachments' } ) ) { foreach ( @{ $email->{ $_->{ 'id' } }->{ 'attachments' } } ) { print ${ $gmail->get_attachment( attachment => $_ ) } . "\n"; if ( $gmail->error() ) { print $gmail->error_msg(); } } } } ### ### Prints out the vendor link from Ads attached to a message my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmail::FOLDERS{ 'INBOX' } ); foreach ( @{ $messages } ) { print "ID: " . $_->{ 'id' } . "\n"; my %email = %{ $gmail->get_indv_email( msg => $_ ) }; if ( $email{ $_->{ 'id' } }->{ 'ads' } ) { my $ads; foreach $ads ( @{ $email{ $_->{ 'id' } }->{ 'ads' } } ) { print " - AD LINK: $ads->{vendor_link}\n"; } } } ### ### Shows different ways to look through your email my $messages = $gmail->get_messages(); print "By folder\n"; foreach ( keys %Mail::Webmail::Gmail::FOLDERS ) { print "KEY: $_\n"; my $messages = $gmail->get_messages( label => $Mail::Webmail::Gmail::FOLDERS{ $_ } ); print "\t$_:\n"; if ( @{ $messages } ) { foreach ( @{ $messages } ) { print "\t\t$_->{ 'subject' }\n"; } } } print "By label\n"; foreach ( $gmail->get_labels() ) { $messages = $gmail->get_messages( label => $_ ); print "\t$_:\n"; if ( defined( $messages ) ) { if ( @{ $messages } ) { foreach ( @{ $messages } ) { print "\t\t$_->{ 'subject' }\n"; } } } } print "All (Note: the All folder skips trash)"; $messages = $gmail->get_messages(); if ( @{ $messages } ) { foreach ( @{ $messages } ) { print "\t\t$_->{ 'subject' }\n"; } } ### ### Update preferences if ( $gmail->update_prefs( signature => 'Test Sig.', max_page_size => 100 ) ) { print "Preferences Updated.\n"; } else { print "Unable to update preferences.\n"; } ### ### Show all contact email addresses my ( @contacts ) = @{ $gmail->get_contacts() }; foreach ( @contacts ) { print $_->{ 'email' } . "\n"; } ### ### Print out space remaining in mailbox my $remaining = $gmail->size_usage(); print "Remaining: '" . $remaining . "'\n"; ### =head1 AUTHOR INFORMATION Copyright 2004-2005, Allen Holman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Address bug reports and comments to: email: mincus \at cpan \. org AIM: mincus c03 Website: http://code.mincus.com When sending bug reports, please provide the version of Gmail.pm, the version of Perl and the name and version of the operating system you are using. =head1 CREDITS I'd like to thank the following people who gave me a little direction in getting this module started (whether they know it or not) =over 4 =item Simon Drabble (Mail::Webmail::Yahoo) =item Erik F. Kastner (WWW::Scraper::Gmail) =item Abiel J. (C# Gmail API - http://www.migraineheartache.com/) =item Daniel Stutz (http://www.use-strict.net) =back =head1 BUGS Please report them. =cut