File Coverage

blib/lib/WWW/Hotmail.pm

Criterion	Covered	Total	%
statement	22	165	13.3
branch	0	54	0.0
condition	0	9	0.0
subroutine	7	16	43.7
pod	4	5	80.0
total	33	249	13.2

package WWW::Hotmail;

use Carp qw(croak);
use base 'WWW::Mechanize';
use 5.006;
use strict;
use warnings;

our $VERSION = '0.10';

our $croak_on_error = 0;
our $errstr = '';
our $errhtml = '';

sub new {
    my $class = shift;
	# avoid complaints from M$ by using IE 6.0
    my $self = $class->SUPER::new(agent => 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)');
    $self->cookie_jar({});
	return $self;
}

sub login {
	my ($self,$email,$pass) = @_;
	unless ($email =~ m/\@([^.]+)\.(.+)/) {
		$errstr = 'You must supply full email addres as the username';
		croak $errstr if $croak_on_error;
		$self->error2html();
		return undef;
	}
	my $domain = lc("$1_$2");
	my $resp = $self->get('http://www.hotmail.com/');
    $resp->is_success || do {
		$errstr = $resp->as_string();
		croak $errstr if $croak_on_error;
		$errhtml = $resp->error_as_HTML;
		return undef;
	};
	# bypass the js detection page
	if ($self->{content} =~ m//i) {
		$self->form_name($1);
		$self->submit();
	}

	$self->form_name('f1');
	# this SHOULD cover charter.com, compaq.net, hotmail.com, msn.com, passport.com, and webtv.net
	# all this java regex crap is needed just for this feature. Maybe this can be done better?
	if ($self->{content} =~ m#name="f1".*action="([^"]+)"#i) {
	#if ($self->{content} =~ m#name="$domain" action="([^"]+)"#) {
		# current_form returns a HTML::Form obj
		$self->current_form()->action($1);
	} else {
		$errstr = 'hotmail format changed or email domain not used with Hotmail';
		croak $errstr if $croak_on_error;
		$self->error2html();
		return undef;
	}
    $self->field(login => $email);
    $self->field(passwd => $pass);
	$resp = $self->submit();
    $resp->is_success || do {
		$errstr = $resp->as_string;
		croak $errstr if $croak_on_error;
		$errhtml = $resp->error_as_HTML;
		return undef;
	};
    #$self->{content} =~ /URL=(.+)"/ or do {
    $self->{content} =~ /replace\(\"(.+?)\"\)/ or do {
		$errstr = 'Hotmail format changed!';
		croak $errstr if $croak_on_error;
		$self->error2html();
		return undef;
	};
    $self->get($1);

	# look for the base url for the mailbox
	if ($self->{content} =~ m/_UM\s*=\s*"([^"]+)";?/) {
		$self->{_WWWHotmail_base} = $1;
	} elsif ($self->{content} =~ m!http://login\.passport\.net/uilogin\.srf!) {
	   	$errstr = 'Couldn\'t log in to Hotmail, username or password incorrect';
		croak $errstr if $croak_on_error;
		$self->error2html();
		return undef;
	} else {
	   	$errstr = 'Couldn\'t log in to Hotmail';
		croak $errstr if $croak_on_error;
		$self->error2html();
		return undef;
	}

	$self->{_WWWHotmail_logged_in} = 1;

	return 1;
}

sub messages {
    my $self = shift;
	unless (defined($self->{_WWWHotmail_logged_in})) {
		$errstr = 'Not logged in!';
		croak $errstr if $croak_on_error;
		$self->error2html();
		return ();
	}
	my $last_page = 1;
	my $i = 1;
	$self->{_WWWHotmail_msgs} = ();
	# traverse all pages
    while ($i <= $last_page) {
		# sorting avoids getting the same message twice
		$self->get('/cgi-bin/HoTMaiL?'.$self->{_WWWHotmail_base}."&page=$i&Sort=rDate");
		# this finds the ->| link (last page)
		if ($i == 1 && $self->{content} =~ m/'page=(\d+)'/i) {
			$last_page = $1;
		}
		# replace javascript junk
		# and adapt it to grab 'from' AND 'subjects'
		# TODO this can be done better
		my $content = $self->content();
		$content =~ s/\r|\n| //g;
		$content =~ s/javascript\:G\('([^']+)'\)">([^<]+)<\/a><\/td>
		$self->update_html($content);
		push(@{$self->{_WWWHotmail_msgs}}, map {
			my $x = WWW::Hotmail::Message->new;
			$x->{_WWW_Hotmail_msg} = $_;
			$x->{_WWW_Hotmail_parent} = $self;
			$x;
		} grep { $_->url() =~ /getmsg/ } @{$self->links});
		$i++;
	}
    return @{$self->{_WWWHotmail_msgs}};
}

sub compose {
	my ($self,%args) = @_;
	my @argkeys = ('to','cc','bcc','subject','body');
	$self->get('/cgi-bin/compose?'.$self->{_WWWHotmail_base});

	$self->form_name('composeform');
	# fill in the form fields
	for(@argkeys) {
		# flatten arrays
		if (ref($args{$_}) eq 'ARRAY') {
			$args{$_} = join(',',@{$args{$_}});
		}
		$self->field($_ => delete $args{$_});
	}
	# warn them of mistakes
	for my $bad (keys %args) {
		warn "unknown key '$bad' passed to compose";
	}
	$self->field(_HMaction => 'Send');
	$self->submit();
	unless($self->content() =~ m/Your message has been sent to/) {
		$errstr = 'Your message failed to send';
		croak $errstr if $croak_on_error;
		$self->error2html();
		$self->form_name('composeform');
		$self->field(_HMaction => 'Cancel');
		$self->submit();
		return undef;
	}
	return 1;
}

sub error2html {
	shift if (ref($_[0]));
	my $body = shift || $errstr;
$errhtml = <

Error

Error
$body


EOM
}

package WWW::Hotmail::Message;
@WWW::Hotmail::Message::ISA = qw(WWW::Hotmail);

use Mail::Audit;

# TODO this can also be done better
sub from { (split(/\|/, shift->{_WWW_Hotmail_msg}->text()))[0] }

sub subject { (split(/\|/, shift->{_WWW_Hotmail_msg}->text()))[1] }

sub _link { shift->{_WWW_Hotmail_msg} }

sub retrieve {
    my $self = shift;
    my $resp = $self->{_WWW_Hotmail_parent}->get($self->_link()->url().'&raw=0');
    $resp->is_success || do {
		$errstr = $resp->as_string;
		croak $errstr if $croak_on_error;
		$errhtml = $resp->error_as_HTML;
		return undef;
	};

	# fix Hotmail's conversions
	my $content = $self->{_WWW_Hotmail_parent}->content();
	$content =~ s/</
	$content =~ s/>/>/gi;
	$content =~ s/"/"/gi;
	$content =~ s/&/&/gi;

	# clip the top and bottom
	my @mail = split(/\n/,$content);
    shift @mail;
	pop @mail until $mail[-1] =~ m||;
	pop @mail;
	# repair line endings
	@mail = map { $_."\n" } @mail;
    my $msg = Mail::Audit->new(data => \@mail);
	# set this option for them
	$msg->noexit(1);
	return $msg;
}

sub delete {
    my $self = shift;
    my $resp = $self->{_WWW_Hotmail_parent}->get($self->_link()->url());
    $resp->is_success || do {
		$errstr = $resp->as_string;
		croak $errstr if $croak_on_error;
		$errhtml = $resp->error_as_HTML;
		return undef;
	};
	# fix java junk
	my $content = $self->{_WWW_Hotmail_parent}->content();
	$content =~ s/href="#" onclick="/href="/gis;
	$content =~ s/G\('([^']+)'\);return false;/$1/gis;
	$self->{_WWW_Hotmail_parent}->update_html($content);
	# loop through links and find the delete link
    for (@{$self->{_WWW_Hotmail_parent}->links()}) {
		# the delete link
		if ($_->[0] && $_->[0] =~ m/action=move&tobox=F000000004/i) {
			$self->{_WWW_Hotmail_parent}->get($_->url());
			last;
		}
   }
   return 1;
}

1;
__END__