view release on metacpan or  search on metacpan

CreateCard.pm  view on Meta::CPAN

#
# Finace::Bank::CreateCard
#
# Version : 1.03
# Date    : Fri Mar 14 13:05:33 GMT 2003 
# By      : Robert J. McKay <robert@mckay.com>
# Desc    : This module provides an interface to the createcard.co.uk 
#	    online banking website.
#

use strict;
use Carp;
use HTTP::Cookies;
use LWP::UserAgent;

#
# UserAgent 
#
package Finance::Bank::CreateCard::WebClient;
our @ISA = qw(LWP::UserAgent);

sub new {

	my ($class, %args) = @_;

	#my $self = LWP::UserAgent->new(@_);

	my $self = LWP::UserAgent->new;

	my $cookiejar = new HTTP::Cookies;

	$self->agent("Mozilla/4.0 (compatible; MSIE 5.01; Windows NT)");

	$self->env_proxy(1);

	$self->timeout(30);

	$self->cookie_jar($cookiejar);

	if (defined($args{login}) && defined($args{password})) {
		$self->auth($args{login}, $args{password});
	}

	bless $self, 'Finance::Bank::CreateCard::WebClient';

	return $self;

}

sub auth {

	my ($self,$login,$password) = @_;

	$self->{login} = $login;

	$self->{password} = $password;

}

sub get_basic_credentials {

	my($self, $realm, $uri) = @_;

	my $netloc = $uri->host_port;

	return ($self->{login}, $self->{password});

}

#
# MAIN PACKAGE
#
package Finance::Bank::CreateCard;
use Carp;
use HTML::TreeBuilder;
our $VERSION = "1.03";
our $BASEURL = "https://www.createcard.co.uk";

our $ua = new Finance::Bank::CreateCard::WebClient;

sub new {

	my ($class, %args) = @_;

	my $self = {};

	bless $self, $class;

	return $self;

}

sub auth {
	my ($self, %args) = @_;

	return $ua->auth($args{login}, $args{password});

}

#
# Log into the website.
# 
sub login {

	my ($class, %args) = @_;

	croak "Must provide a password" unless exists $args{password};
	croak "Must provide a username" unless exists $args{username};

	my $self = bless { %args }, $class;

	my $orig_r = $ua->get("$BASEURL/create-servicing/Start.jsp?PERL");

	croak $orig_r->error_as_HTML unless $orig_r->is_success;

	my $login =
	$ua->post("$BASEURL/create-servicing/login.do", {
		username=> $args{username},
		password=> $args{password},
		"submit.x"=>"1",