File Coverage

blib/lib/Finance/Bank/Natwest.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	4	6	66.6
condition	2	3	66.6
subroutine	12	12	100.0
pod	2	3	66.6
total	81	85	95.2

package Finance::Bank::Natwest;
use strict;
use vars qw( $VERSION );

use Carp;
use HTML::TokeParser;
use Finance::Bank::Natwest::Connection;

$VERSION = '0.05';

=head1 NAME

Finance::Bank::Natwest - Check your Natwest bank accounts from Perl

=head1 DESCRIPTION

This module provides a rudimentary interface to the Natwest online
banking system at C. You will need
either C or C installed for HTTPS
support to work with LWP.

=head1 SYNOPSIS

  my $nw = Finance::Bank::Natwest->new( credentials => 'Constant',
                                        credentials_options => {
					   dob => '010179',
					   uid => '0001',
					   password => 'Password',
					   pin => '4321' } );

  my @accounts = $nw->accounts;

  foreach (@accounts) {
        printf "%25s : %6s / %8s : GBP %8.2f\n",
          $_->{name}, $_->{sortcode}, $_->{account}, $_->{available};
  }

=head1 METHODS

=over 4

=item B

  my $nw = Finance::Bank::Natwest->new( credentials => 'Constant',
                                        credentials_options => {
					   dob => '010179',
					   uid => '0001',
					   password => 'Password',
					   pin => '4321' }
  );

  # Or create the credentials object ourselves
  my $credentials = Finance::Bank::Natwest::CredentialsProvider::Constant->new(
     dob => '010179', uid => '0001', password => 'Password', pin => '4321' );

  my $nw = Finance::Bank::Natwest->new( credentials => $credentials );


C can be called in two different ways. It can take a single parameter,
C, which will accept an already created credentials object, of type
C. Alternatively, it can take two
parameters, C and C. In this case
C is the name of a credentials class to create an instance of, and
C is a hash of the options to pass-through to the
constructor of the chosen class.

If the second form of C is being used, and the chosen class is I one
of the ones supplied as standard then it will need to be C first.

If any errors occur then C will C.

=cut

use constant URL_ROOT => 'https://www.nwolb.com';
use constant DIR_BASE => '/secure/';

sub url_base { $_[0]->URL_ROOT . $_[0]->DIR_BASE };

sub new {
    my ($class, %opts) = @_;

    my $self = bless {}, $class;

    {
       local $Carp::CarpLevel = $Carp::CarpLevel + 1;
       $self->{connection} = Finance::Bank::Natwest::Connection->new(
          %opts, url_base => $self->url_base
       );
    }

    $self->_load_accounts();

    return $self;
};

=item B

  my @accounts = $nw->accounts;

  # Or get a list ref instead
  my $accounts = $nw->accounts;

Returns a list containing a summary of any accounts available from the
supplied credentials. Each item in the list is a hash reference that holds
summary information for a single account, and contains this data:

=over 4

=item B - the name of the account

=item B - the account number

=item B

=item B

=item B - the currently available funds

=back

=cut

sub accounts {
   my $self = shift;

   return unless defined wantarray;

   return wantarray ? @{$self->{data}{accounts}} : $self->{data}{accounts};
}

sub _load_accounts {
   my $self = shift;

   my ($accountlist, $ministmt) =
      ($self->{connection}->post("Balances.asp?0") =~
         /(.*?)<\/form>(.*?)/s);

   $self->{data}{accounts} = $self->_process_accountlist($accountlist);

}

sub _process_accountlist{
   my ($self, $accountlist) = @_;
   my (@accounts, $stream, $token);

   $stream = HTML::TokeParser->new(\$accountlist) or croak "$!, stopped";

   $stream->get_tag("tr");
   while ($token = $stream->get_tag("tr") and exists $token->[1]{class}) {
      $token = $stream->get_tag("td");

      my $name = $stream->get_trimmed_text("/td");
      $stream->get_tag("td"); $stream->get_tag("span");

      $name =~ s/\xa0+/ /;
      $name =~ s/^\s+//;
      $name =~ s/\s+$//;

      my $sortcode = $stream->get_trimmed_text("/span");
      $stream->get_tag("span");

      my $account = $stream->get_trimmed_text("/span");
      $stream->get_tag("td");

      my $balance = $stream->get_trimmed_text("/td");
      $stream->get_tag("td");

      $balance =~ s/\xa3//;
      $balance =~ s/,//g;

      my $available = $stream->get_trimmed_text("/td");
      $available =~ s/\xa3//;
      $available =~ s/,//g;

      push @accounts, {
         name      => $name,
         account   => $account,
         sortcode  => $sortcode,
         balance   => $balance,
         available => $available,
      };
   }

   return \@accounts;
};

1;
__END__