#!/usr/bin/perl -w
package NWOLB::Cookies;
use warnings;
use strict;
use vars qw/@ISA/;
BEGIN { require HTTP::Cookies; push @ISA, 'HTTP::Cookies'; }
# Natwest uses 01-Jan-1900 instead of 01-Jan-1970 to delete a cookie.
# Unfortunately, Time::Local, the underlying date/time library used
# to process the expires string, typically can't cope properly with
# that date, and complains about it to us.
sub extract_cookies
{
my $self = shift;
my $response = shift || return;
my @ns_set = $response->header("Set-Cookie");
s/(;?\s+expires)=Mon, 01-Jan-1900/$1=Thu, 01-Jan-1970/ for @ns_set;
$response->header("Set-Cookie", \@ns_set);
return $self->SUPER::extract_cookies($response);
}
package main;
use warnings;
use strict;
#use LWP::Debug qw(+);
use Data::Dumper;
use WWW::Mechanize;
use HTML::TreeBuilder;
my $my_dob = '010170';
my $my_uid = '0001';
my $my_pin = '1234';
my $my_pass = 'Password';
use constant POSS_PIN => { first => 0, second => 1, third => 2, fourth => 3 };
use constant POSS_PASS =>
{ first => 0, second => 1, third => 2, fourth => 3, fifth => 4,
sixth => 5, seventh => 6, eighth => 7, ninth => 8, tenth => 9,
eleventh => 10, twelfth => 11, thirteenth => 12, fourteenth => 13,
fifteenth => 14, sixteenth => 15, seventeenth => 16,
eighteenth => 17, nineteenth => 18, twentieth => 19
};
my $mech = WWW::Mechanize->new(
keep_alive => 1,
timeout => 30,
cookie_jar => NWOLB::Cookies->new(),
requests_redirectable => [ 'GET', 'HEAD', 'POST' ],
agent => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
);
print "* Starting login process...\n";
$mech->get('
https://www.nwolb.com/');
print "* Following internal hateful javascript redirect...\n";
if ($mech->res->decoded_content !~ /top\.window\.document\.location\.href\s+=\s+'([^']+)'/) {
die "Can't find the redirect\n";
}
my $url = $1;
$mech->get($url);
print "* Following frame login link...\n";
$mech->follow_link(tag => "frame");
print "* Checking we're on step 1 as expected...\n";
my $content = $mech->res->decoded_content;
if ($content =~ /We're \s+ sorry \s+ but \s+ the \s+ service \s+ is \s+ temporarily \s+ unavailable/ix) {
die "Service temporarily unavailable.\n";
}
if ($content !~ /Log \s+ In \s+ - \s+ Step \s+ 1/ix) {
die "Page doesn't look like expected, sorry.\n";
}
print "* Submitting customer number...\n";
$mech->submit_form(fields => { DBID_edit => $my_dob.$my_uid });
print "* Deciphering pin/pass request...\n";
my $root = HTML::TreeBuilder->new_from_content($mech->res->decoded_content)->elementify;
my @questions = $root->look_down( _tag => 'label', id => qr/^LI6DDAL[A-F]Label$/ );
my %pin_req = ();
my %pass_req = ();
for (@questions) {
my $question = lc(($_->content_list)[0]);
if ($question =~ /^enter \s+ the \s+ ([^\s]+) \s+ (?:digit|character) \s+ from \s+ your \s+ (pin|password)/gcx) {
my ($req, $req_type) = ($1, $2);
if ($req_type =~ /pin/) {
die "Unrecognized pin request: $req\n" unless exists POSS_PIN->{$req};
$pin_req{$_->attr('for')} = POSS_PIN->{$req};
} else {
die "Unrecognized password request: $req\n" unless exists POSS_PASS->{$req};
$pass_req{$_->attr('for')} = POSS_PASS->{$req};
}
} else {
die "Unrecognized question: $question\n";
}
}
$root->delete;
for (keys %pin_req) {
$pin_req{$_} = substr $my_pin, $pin_req{$_}, 1;
}
for (keys %pass_req) {
$pass_req{$_} = substr $my_pass, $pass_req{$_}, 1;
}
print "* Submitting requested pin/pass details...\n";
$mech->submit_form(fields => { %pin_req, %pass_req });
$content = $mech->res->content;
print "* Checking we're not back at step 1, which indicates incorrect details...\n";
if ($content =~ /Log \s+ In \s+ - \s+ Step \s+ 1/ix) {
die "Incorrect customer details.\n";
}
print "* Looking for last login message...\n";
$root = HTML::TreeBuilder->new_from_content($content)->elementify;
my @last = $root->look_down( _tag => 'td', class => 'wizardLabel' );
for my $last (@last) {
if ($last->as_text =~ /Date of last log in:/i) {
my $date = $last->right;
if(defined $date) {
$date = $date->as_trimmed_text;
print "Last logged in at: $date\n";
last;
}
}
}
$root->delete;
print "* Following through out of the login system...\n";
$url = $mech->uri;
for (1..3) {
$mech->submit;
last if $mech->uri ne $url;
}
die "Not left login after three attempts\n" if $mech->uri eq $url;
die "Not where expected to be\n" if $mech->uri ne '
https://www.nwolb.com/AccountSummary.aspx';
print "* Looking for account data...\n";
$root = HTML::TreeBuilder->new_from_content($mech->res->decoded_content)->elementify;
my $accounts = $root->look_down( _tag => 'table', id => 'Accounts' );
die "Couldn't find the account data\n" unless defined $accounts;
my @accounts = $accounts->look_down( _tag => 'tr', class => qr/^dt(?:o|em)?$/ );
die "Couldn't find the account data\n" unless @accounts;
for my $account (@accounts) {
my @details = $account->look_down( _tag => 'td' );
die "Account details don't look like expected\n" unless @details == 5;
my $url = $mech->uri;
my $href = $details[0]->look_down( _tag => 'a');
if (defined $href) {
$href = $href->attr('href');
$href =~ s|^/||;
$url = "
https://www.nwolb.com/$href";
}
$account = { map { (qw(name number sortcode balance available))[$_] => $details[$_]->as_trimmed_text } 0..4 };
$account->{number} =~ s/\s//g;
$account->{sortcode} =~ s/\s//g;
for (qw(balance available)) {
$account->{$_} =~ s/\xa3//;
$account->{$_} =~ s/,//g;
}
$account->{ministmt_url} = $url;
}
$root->delete;
for (@accounts) {
print "* Getting mini-stmt for account: $_->{name}\n";
$mech->get($_->{ministmt_url}) unless $mech->uri eq $_->{ministmt_url};
$root = HTML::TreeBuilder->new_from_content($mech->res->decoded_content)->elementify;
my $ministmt = $root->look_down( _tag => 'table', id => 'MiniStatementNAP' );
die "Couldn't find the mini-statement data\n" unless defined $ministmt;
my @transactions = $ministmt->look_down( _tag => 'tr', class => qr/^dt(?:o|hi)?$/ );
die "Couldn't find the mini-statement data rows\n" unless @transactions;
my @trans;
for my $transaction (@transactions) {
my @details = $transaction->look_down( _tag => 'td' );
die "Transaction details don't look like expected\n" unless @details == 4;
my $provisional = $transaction->attr('class') =~ /^dthi$/i;
$transaction = { map { (qw(date description in out))[$_] => $details[$_]->as_trimmed_text } 0..3 };
for (qw(in out)) {
$transaction->{$_} =~ s/\xa3//;
$transaction->{$_} =~ s/,//g;
$transaction->{$_} = undef if $transaction->{$_} eq '-';
}
$transaction->{provisional} = $provisional;
push @trans, $transaction;
}
$_->{ministmt} = \@trans;
}
print "Your details...\n\n";
for my $account (@accounts) {
print "Account name: $account->{name}\n";
print " Account number: $account->{number}\n";
print " Sort code: $account->{sortcode}\n";
print " Balance: $account->{balance}\n";
print " Available: $account->{available}\n";
print "\n";
for my $transaction (@{$account->{ministmt}}) {
if ($transaction->{date} =~ /^\d\s/) {
print " Date: $transaction->{date}";
} else {
print " Date: $transaction->{date}";
}
printf " In: %8.2f", $transaction->{in} if defined $transaction->{in};
printf " Out: %8.2f", $transaction->{out} if defined $transaction->{out};
print " Desc: $transaction->{description}";
print " [PROVISIONAL]" if $transaction->{provisional};
print "\n";
}
print "\n\n";
}
print "Successfully got to the end, yay. Please check the above output for errors and report back, thanks.\n";
#print Dumper $mech->content;
