File Coverage

blib/lib/Finance/Bank/DE/DeutscheBank.pm

Criterion	Covered	Total	%
statement	37	268	13.8
branch	0	90	0.0
condition	0	50	0.0
subroutine	13	31	41.9
pod	5	17	29.4
total	55	456	12.0

package Finance::Bank::DE::DeutscheBank;
use strict;
use warnings;
use Carp;
use base 'Class::Accessor';

use WWW::Mechanize;
use HTML::LinkExtractor;
use HTML::TreeBuilder;
use Text::CSV_XS;


use vars qw[ $VERSION ];

$VERSION = '0.06';

BEGIN	{
		Finance::Bank::DE::DeutscheBank->mk_accessors(qw( agent ));
	};

use constant BASEURL	=> 'https://meine.deutsche-bank.de';
use constant LOGIN	=> BASEURL . '/trxm/db/';
use constant FUNCTIONS	=> "(Übersicht)|(Ihr Konto)|(Ihr Depot)|(Service / Optionen)|(Umsatzanzeige)|(Inlands-Überweisung)|(Daueraufträge)|(Lastschrift)|(Kunden-Logout)|(Überweisungsvorlagen)|(Ihre Finanzübersicht als PDF-Datei speichern)|(Ihre Finanzübersicht als CSV-Datei speichern)|(Customer-Logout)|(Overview)|(Your account)|(Your sec. account)|(Service / Options)|(Transactions)|(Domestic transfer order)|(Standing orders)|(Direct debit)|(Transfer order templates)|(Customer-Logout)|(Save as PDF File)|(Save as CSV File)|(Save your financial overview as PDF file)|(Save your financial overview as CSV file)";


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

	croak "Filiale/Branch number must be specified"
		unless $args{Branch};

	croak "Konto/Account number must be specified"
		unless $args{Account};

	croak "Unterkonto/SubAccount number must be specified"
		unless $args{SubAccount};

	croak "PIN/Password must be specified"
		unless $args{PIN};

	my $logger = $args{status} || sub {};

	my $self = {
			agent		=> undef,
			account		=> $args{Account},
			password	=> $args{PIN},
			branch		=> $args{Branch},
			subaccount	=> $args{SubAccount},
			logger		=> $logger,
			navigation	=> undef,
		};
	bless $self, $class;

	$self->log("New $class created");
	$self;
};


sub log
{
	$_[0]->{logger}->(@_);
};


sub log_httpresult
{
	$_[0]->log("HTTP Code",$_[0]->agent->status,$_[0]->agent->res->as_string)
};


sub new_session
{
	# Reset our user agent
	my ($self) = @_;
	my $url;

	$self->close_session()
		if ($self->agent);

	my $result = $self->get_login_page(LOGIN);

	if ( $result != 200 )
	{
		$self->log("Status"," Banking is unavailable");
		die "Banking is unavailable";
	}

	if ( $result == 200 )
	{
		if ($self->maintenance)
		{
			$self->log("Status","Banking is unavailable due to maintenance");
			die "Banking unavailable due to maintenance";
		};

		my $agent = $self->agent();
		my $function = 'ACCOUNTBALANCE';
		$self->log("Logging into function $function");

		# gvo=DisplayFinancialOverview&loginTab=iTAN&javascriptEnabled=true&branch=XXX&account=XXXXXX&subaccount=XX&pin=XXXXX&quickLink=DisplayFinancialOverview
		$agent->current_form->value('gvo','DisplayFinancialOverview');
		$agent->current_form->value('loginTab','iTAN');
		$agent->current_form->value('javascriptEnabled','false');
		$agent->current_form->value('quickLink','DisplayFinancialOverview');
		$agent->current_form->value('account',$self->{account});
		$agent->current_form->value('branch',$self->{branch});
		$agent->current_form->value('subaccount',$self->{subaccount});
		$agent->current_form->value('pin',$self->{password});
		$agent->add_header('Accept-Charset' => 'utf-8');
		$agent->add_header('Accept-Encoding' => '');

		local $^W=0;
		$result = $agent->submit();

		if ( $self->access_denied )
		{
			$self->log("Not possible to authenticate at bank server ( wrong account/pin combination ? )");
			return 0;
		}

		# extract links to account functions
		my $LinkExtractor = new HTML::LinkExtractor();

		$LinkExtractor->strip( 1 );
		$LinkExtractor->parse(\$agent->content());

		# needed here because of empty links ( href attribute )
		local $^W=1;

		# now we have the links in the format
		#	{
		#		'_TEXT' => 'Overview',
		#		'target' => '_top',
		#		'href' => '/mod/WebObjects/dbpbc.woa/618/wo/HpRl1hqezkxfYRosJRjTg0/4.11.1.5.3.3.5.3',
		#		'tag' => 'a',
		#		'class' => 'NaviDirektLink'
		#	},
		#	{	...
		#	}
		#


		# but I would like to have them as
		# 	{
		# 		'_TEXT' => 'Overview',
		# 		'href' => '/mod/WebObjects/dbpbc.woa/618/wo/HpRl1hqezkxfYRosJRjTg0/4.11.1.5.3.3.5.3',
		# 	},
		# 	{	...
		#	}
		# and only for functions ( not all links and images ... )

		my @tmp = ();
		foreach my $elem ( @{$LinkExtractor->links} )
		{
			if (( defined( $elem->{ '_TEXT' } ) && ( $elem->{ '_TEXT' } ne '' ) && ( $elem->{ '_TEXT' } =~ "m/". FUNCTIONS ."/" )) )
			{
				foreach $_ ( keys %$elem )
				{
					if ( $_ !~ m/(_TEXT)|(href)/ )
					{
						delete $elem->{ $_ };
					}
				}

				push @tmp, \%$elem;
			}
		}

		# save these links so that we can remember them
		$self->{navigation} = \@tmp;
		$self->log_httpresult();
		$result = $agent->status;
	};
	$result;
};


sub get_login_page
{
	my ($self,$url) = @_;
	$self->log("Connecting to $url");
	$self->agent(WWW::Mechanize->new(agent => "Mozilla/4.78 (Linux 2.4.19-4GB i686; U) Opera 6.03 [en]",  cookie_jar => {} ));

	my $agent = $self->agent();
	$agent->add_header('Accept-Language' => 'en-us,en;q=0.5');
	$agent->get(LOGIN);
	$self->log_httpresult();
	$agent->status;
};


sub error_page
{
	# Check if an error page is shown (a page with much red on it)
	my ($self) = @_;
	my $content = $self->agent->content;
	$content =~ s!Bitte beachten Sie, da\ß die "Hochstell-Taste" \(Capslock\) aktiv ist.!!;
	$content =~ s!Please note capslock-key is active.!!;
	$content =~ /
};


sub maintenance
{
	my ($self) = @_;

	# would be nice if someone could mail me the actual english and german messages which are displayed in case of maintenance ...
	$self->error_page or
	$self->agent->content =~ /derzeit steht das Internet Banking aufgrund von Wartungsarbeiten leider nicht zur Verfügung.\s*\s*In Kürze wird das Internet Banking wieder wie gewohnt erreichbar sein./gsm;
};


sub access_denied
{
	my ($self) = @_;
	my $content = $self->agent->content;

	$self->error_page or
	(  $content =~ /Die eingegebene Kontonummer ist unvollständig oder falsch\..*\(2051\)/gsm
		or $content =~ /Die eingegebene PIN ist falsch\. Bitte geben Sie die richtige PIN ein\.\s*\(10011\)/gsm
		or $content =~ /Die von Ihnen eingegebene Kontonummer ist ungültig und entspricht keiner Deutsche Bank-Kontonummer.\s*\(3040\)/gsm
		or $content =~ /Leider konnte Ihre Anmeldung nicht erfolgreich durchgeführt werden/
		or $content =~ /Unfortunately, you were not able to register successfully./
		or $content =~ /Bitte überprüfen Sie Ihre Anmeldedaten oder versuchen Sie es zu einem späteren Zeitpunkt noch einmal./
		or $content =~ /Please check your registration data or try again later./
		or $content =~ /Bitte geben Sie ein gültiges Datum ein/
	);
};


sub session_timed_out
{
	my ($self) = @_;
	$self->agent->content =~ /Die Sitzungsdaten sind ungültig, bitte führen Sie einen erneuten Login durch.\s+\(27000\)/;
};


sub functions
{
	my ($self,$function) = @_;
	my $link = ();

    	if ( $function =~ "m/". FUNCTIONS ."/" )
	{
		foreach $_ ( @{$self->{ navigation }} )
		{
			if ( $_->{ '_TEXT' } eq $function )
			{
				$link = $_->{ 'href' };
			}
		}
		return $link;
	}
	else
	{
		return 0;
	}
}


sub select_function
{
	my ($self,$function) = @_;
	carp "Unknown account function '$function'"
		unless $self->functions($function);

	$self->new_session unless $self->agent;
	$self->agent->get( $self->functions( "$function" ) );

	if ( $self->session_timed_out )
	{
		$self->log("Session timed out");
		$self->agent(undef);
		$self->new_session();
		$self->agent->get( $self->functions( $function ) );
	};
	$self->log_httpresult();
	$self->agent->status;
};


sub close_session
{
	my ($self) = @_;
	my $result;
	if (not $self->access_denied)
	{
		$self->log("Closing session");
		local $^W=0;
		$self->select_function('Customer-Logout');
		local $^W=1;
		$result = $self->agent->res->as_string =~ /https:\/\/meine.deutsche-bank.de\/trxm\/db\/.*;link=trxm_en_logout-pbcde-to-txm_login.*/;
	}
	else
	{
		$result = 'Never logged in';
	};
	$self->agent(undef);
	$result;
};


sub login
{
	my ($self) = @_;

	if ( $self->new_session() )
	{
		return 1;
	}
	else
	{
		return 0;
	}

};


sub parse_account_overview
{
	my ($self) = @_;
	my $agent = $self->agent();
	my %saldo = ();

	my $tree = HTML::TreeBuilder->new();
	$tree->parse( $agent->content() );

	foreach my $table ( $tree->look_down('_tag', 'table') )
	{
		foreach my $row ( $table->look_down('_tag', 'tr') )
		{
			foreach my $child ( $row->look_down('_tag', 'td') )
			{
				if (( defined $child->attr('class')) && ( $child->attr('class') eq 'balance'))
				{
					my $tmp = $child->as_trimmed_text;

					if ( $child->attr('class') eq 'balance')
					{
						if ( $tmp =~ m/\.[0-9][0-9]$/ )
						{
							$tmp =~ s/\./#/;
							$tmp =~ s/,/./g;
							$tmp =~ s/#/,/;
						}
						$saldo{ 'Saldo' }  = $tmp;
					}
				}

				foreach my $morechildren ( $child->look_down('_tag', 'acronym') )
				{
					if (( defined $morechildren->attr('title')) && ( $morechildren->attr('title') eq 'Euro'))
					{
						$saldo{ 'Währung' } = $morechildren->as_trimmed_text;
					}
				}
			}
		}
	}
	return %saldo
}


sub saldo
{
	my ($self) = @_;
	my $agent = $self->agent;
	if ($agent)
	{
		local $^W=0;
		$self->select_function('Overview');
		local $^W=1;
		return $self->parse_account_overview();
	}
	else
	{
		return undef;
	}
};


sub MapData
{
	my ( @data ) = @_;
	for my $row ( @data )
	{
		foreach $_ ( keys %$row  )
		{
			if (( $_ eq 'Haben' )||( $_ eq 'Soll' ))
			{
				$row->{ $_ }  =~ s/\./#/;
				$row->{ $_ }  =~ s/,/./g;
				$row->{ $_ } =~ s/#/,/;
			}
			elsif (( $_ eq 'Buchungstag' )||( $_ eq 'Wert' ))
			{
				my @tmp = split( /\//, $row->{ $_ } );
				$row->{ $_ }  = join( '.', $tmp[1], $tmp[0], $tmp[2] );
			}
			elsif ( $_ eq 'Waehrung' )
			{
				my $tmp = $row->{ 'Waehrung' };
				delete $row->{ 'Waehrung' };
				$row->{ 'Währung' } = $tmp;
			}
		}
	}
	return @data;
}


sub account_statement
{
	my ($self, %parameter) = @_;

	my $count = 0;
	my @header = ();
	my @AccountStatement = ();
	my $AccountRow = ();
	my @date;
	my $agent = $self->agent;
	if ($agent)
	{
		local $^W=0;
		$self->select_function('Overview');

		my %account = $self->parse_account_overview();
		$agent->follow_link( 'text' => 'Transactions' );
		local $^W=1;

		# should I get account statement for user defined period ?
		if ( defined $parameter{ 'period' } )
		{
			my ( $day, $month, $year ) = split( '\.', $parameter{ 'StartDate' } );

			$day	= sprintf("%02d", $day );
			$month	= sprintf("%02d", $month );
			$year	= sprintf("%04d", $year );

			croak "Year must have 4 digits in StartDate"
				unless ( length $year == 4 );

			$agent->current_form->value( 'period','dynamicRange');
			$agent->current_form->value( 'periodStartDay', $day );
			$agent->current_form->value( 'periodStartMonth', $month );
			$agent->current_form->value( 'periodStartYear', $year );

			( $day, $month, $year ) = split( '\.', $parameter{ 'EndDate' } );
			$day	= sprintf("%02d", $day );
			$month	= sprintf("%02d", $month );
			$year	= sprintf("%04d", $year );

			croak "Year must have 4 digits in EndDate"
				unless (( length $year == 4 )&&( $year > 1900 ));

			$agent->current_form->value( 'period','dynamicRange');
			$agent->current_form->value( 'periodEndDay', $day );
			$agent->current_form->value( 'periodEndMonth', $month );
			$agent->current_form->value( 'periodEndYear', $year );
		}
		elsif ( defined $parameter{ 'last' } )
		{
			my $last = ();
			$agent->current_form->value('period','fixedRange');
			if ( $parameter{ 'last' } <= 10 )
			{
				$last = 10;
			}
			elsif ( $parameter{ 'last' } <= 20 )
			{
				$last = 20;
			}
			elsif ( $parameter{ 'last' } <= 30 )
			{
				$last = 30;
			}
			elsif ( $parameter{ 'last' } <= 60 )
			{
				$last = 60;
			}
			elsif ( $parameter{ 'last' } <= 90 )
			{
				$last = 90;
			}
			elsif ( $parameter{ 'last' } <= 120 )
			{
				$last = 120;
			}
			else	# > 120
			{
				$last = 180;
			}
			$agent->select('periodDays', $last);
		}
		else	#expect that per default last login date is set ...
		{
			;
		}

		local $^W=0;
		# 'refresh view' is used to trigger update of account balance
		my $result = $agent->submit();

		# download CSV formated data of account balances
		$result = $agent->follow_link( text_regex => qr/Save your account turnover as.*CSV.*file/ );
		local $^W=1;

		#successfully downloaded account balance data in csv format
		if ( $result->is_success )
		{
			my @balance = split( '\n', $result->content );
			my $csv = Text::CSV_XS->new( { 'sep_char'    => ';' });

			my $StartLineDetected = 0;
			for ( my $loop = 0; $loop < scalar @balance; $loop++ )
			{
				my $line = $balance[ $loop ];
				chomp( $line );

				$line =~ s/^Booking date;/Buchungstag;/;
				$line =~ s/;Value date;/;Wert;/;
				$line =~ s/;Transactions Payment details;/;Verwendungszweck;/;
				$line =~ s/;Debit;/;Soll;/;
				$line =~ s/;Credit;/;Haben;/;
				$line =~ s/;Currency/;Waehrung/;
				$line =~ s/^Account balance;/Kontostand;/;

				if ( $StartLineDetected == 1 )
				{
					my $status = $csv->parse( $line );
					@header = $csv->fields();
					$AccountRow = 0;
					@AccountStatement = ();
					$StartLineDetected = 2;
				}
				elsif ( $StartLineDetected == 2 )
				{
					if ( $line !~ /^Kontostand;/ )
					{
						my $status = $csv->parse( $line );
						my @columns = $csv->fields();

						for (my $loop = 0; $loop < scalar @columns; $loop++ )
						{
							$AccountStatement[ $AccountRow ]{ $header[ $loop ] } = $columns[ $loop ];
						}
						$AccountRow++;
					}
				}
				elsif (	( $line =~ /Vorgemerkte und noch nicht gebuchte Umsätze sind nicht Bestandteil dieser Aufstellung/ )||
					( $line =~ /Transactions pending are not included in this report/ ) )
				{
					$StartLineDetected = 1;
				}
			}
			return MapData( @AccountStatement );
		}
		else
		{
			return undef;
		}
	}
	else
	{
		return undef;
	}
}


1;
__END__