view release on metacpan or  search on metacpan

lib/Finance/Bank/Natwest/Connection.pm  view on Meta::CPAN

package Finance::Bank::Natwest::Connection;
use strict;
use vars qw( $VERSION );
use Carp;
use LWP::UserAgent;

$VERSION = '0.04';

require Finance::Bank::Natwest;

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
    };


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

    my $self = bless {}, $class;

    $self->{url_base} = $opts{url_base} || Finance::Bank::Natwest->url_base;

    $self->_set_credentials( %opts );
    $self->_new_ua( %opts );
    
    return $self;
}

sub _new_ua{
    my ($self, %opts) = @_;

    my %proxy;

    if (exists $opts{proxy}) {
        $proxy{env_proxy} = 0;
        $proxy{proxy} = $opts{proxy} if 
            $opts{proxy} ne 'no' and $opts{proxy} ne 'env';
        $proxy{env_proxy} = 1 if $opts{proxy} eq 'env';
    } else {
        $proxy{env_proxy} = 1;
    }

    $self->{ua} = LWP::UserAgent->new(
        env_proxy => $proxy{env_proxy},
        keep_alive => 1,
        timeout => 30,
        cookie_jar => {},
        requests_redirectable => [ 'GET', 'HEAD', 'POST' ],
        agent => "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    );

    $self->{ua}->proxy('https', $proxy{proxy}) if exists $proxy{proxy};
}

sub _set_credentials{
    my ($self, %opts) = @_;

    croak "Must provide either a premade credentials object or ".
          "a class name together with options, stopped" if
        !exists $opts{credentials};

    if (ref($opts{credentials})) {
        croak "Can't accept credential options if supplying a premade ".
              "credentials object, stopped" if
            exists $opts{credentials_options};

        croak "Not a valid credentials object, stopped" unless
            $self->_isa_credentials($opts{credentials});

        $self->{credentials} = $opts{credentials};
    } else {
        croak "Must provide credential options unless suppying a premade ".
              "credentials object, stopped" if
            !exists $opts{credentials_options};

        $self->{credentials} =
            $self->_new_credentials(
                $opts{credentials}, $opts{credentials_options}
            );
    };
}

sub _new_credentials{
    my ($self, $class, $options) = @_;

    croak "Invalid class name, stopped" if
        $class !~ /^(?:\w|::)+$/;
    
    my $full_class = "Finance::Bank::Natwest::CredentialsProvider::$class";
    
    eval "local \$SIG{'__DIE__'}; 
          local \$SIG{'__WARN__'}; 
          require $full_class;
         ";
    croak "Not a valid credentials class, stopped"
        if $@;

    croak "Not a valid credentials class, stopped"
        unless $self->_isa_credentials($full_class);

    {
        local $Carp::CarpLevel = $Carp::CarpLevel + 1;
        return $full_class->new(%{$options});
    }
}