#!/usr/bin/perl
#
# everyone.pl
# - download text-only emails from everyone.net webmail servers.
#
use strict;
use warnings;
use WWW::Mechanize;
use constant DEBUG => 1;
my $login = 'mylogin';
my $passwd = 'mypassword';
my $folder = shift;
die "Usage: $0 FOLDER\n" unless $folder;
my $base = "http://www.canadamail.de/email/scripts";
my $loginuser = "$base/loginuser.pl";
my $ua
= "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.12) Gecko/20050922 Firefox/1.0.7 (Debian package 1.0.7-1)";
# Create a new instance of WWW::Mechanize
my $mech = WWW::Mechanize->new( autocheck => 1 );
# Set User Agent
$mech->agent($ua);
# Continue with other tasks...
DEBUG && print STDERR "Getting login page...\n";
$mech->get($loginuser);
$mech->form("myForm");
$mech->field( "loginName", $login );
$mech->field( "user_pwd", $passwd );
$mech->field( "store_pwd", "on" );
DEBUG && print STDERR "Logging in...\n";
$mech->click("login");
my $main = "$base/main.pl?folder=$folder";
DEBUG && print STDERR "Getting: $main\n";
$mech->get($main);
my $magic; # Session ID
my %mid; # Mesage IDs
for my $line ( split( $/, $mech->content() ) ) {
$magic = $1
if $line =~
/^ document.myForm.action = 'view.pl.EV1=([0-9]+)';/;
$mid{$1} = $1
if $line =~ /| $mid,
"folder" => $folder,
"fullHeaders" => "1",
);
DEBUG && print STDERR "Getting: $mid\n";
$mech->post( $view, \%form );
my $content = $mech->content();
#
# Strip off the start of the page down to the mail headers
#
$content =~
s|.*Add Sender To Address Book\s*||sg;
#
# Strip end of page after message
#
$content =~ s|\n | .*$||sg;
#
# Strip the attachments block
#
$content =~ s|| Attachments | .*?\n||sg;
#
# Special header fixes
#
# Chop the last table block before the header
$content =~ s|\s*| | \s*| ||sg;
#
# So header lines don't come out double spaced
#
$content =~ s| | \s+||sg;
#
# Put line breaks in the right places in the header
#
$content =~ s/
/\n/g;
#
# Strip any remaining page tags
#
for my $tag ( qw( tr td table img b ) ) {
$content =~ s|<$tag[^>]*>||sg;
$content =~ s|]*>||sg;
}
#
# Remove links
#
$content =~ s/]+>//sg;
$content =~ s|||g;
#
# Reformat entities as text
#
$content =~ s/ / /g;
$content =~ s/&/\&/g;
$content =~ s/>/>/g;
$content =~ s/</ $out") || die "Can't write to '$out': $!\n";
print OUT "$content\n";
close(OUT);
$form{"doDelete"} = "1";
$form{"midlist"} = "$mid";
DEBUG && print STDERR "Deleting: $mid\n";
$mech->post( $view, \%form );
}
|
| |
|