File Coverage

blib/lib/Finance/Bank/DE/DTA/Create.pm

Criterion	Covered	Total	%
statement	18	54	33.3
branch	0	14	0.0
condition	0	18	0.0
subroutine	6	9	66.6
pod			n/a
total	24	95	25.2

###############################################################################
package Finance::Bank::DE::DTA::Create;
#
###############################################################################
# Dta class provides functions to create and handle with DTA files
# used in Germany to exchange informations about money transactions with
# banks or online banking programs.
###############################################################################

use strict;
use warnings;
use Carp;
use POSIX qw(strftime);
use Time::Local;
use vars qw($VERSION);
$VERSION = 1.03;

sub new {
	my $that = shift;
	$that = ref($that) || $that;
	my $self = {
		items          => 0,
		amount         => 0,
		sum_accounts   => 0,
		sum_bank_codes => 0,
	};

	bless $self, $that;
	return $self->_initialize(shift);
}

#****s*	_initialize
#
#	DESCRIPTION
#		Initialisierung des DTA Objekts, wir von new() aufgerufen.
#
#	PARAMETER
#		%file		optional: Accountfile des Kontoinhabers
#
#	RETURN
#		Objekt im Erfolgsfall, 0 wenn Fehlgeschlagen
#
#******************************************************************************
sub _initialize {
	my $self = shift;
	my $file = shift;    # Account file sender
	$self->{timestamp} = time();
	$self->{exchanges} = [];
	foreach my $i (
		32, 36, 37, 38, 42, 43, 44, 45, 46, 47, 48,  49,  50,  51, 52, 53, 54, 55,
		56, 57, 65, 66, 67, 68, 69, 70, 71, 72, 73,  74,  75,  76, 77, 78, 79, 80,
		81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 196, 214, 220, 223
	  )
	{
		$self->{_validChars}{"$i"} = 1;
	}
	if ( $file->{type} && $file->{type} eq "credit" ) {
		$self->{type} = "0";
	}
	elsif ( $file->{type} && $file->{type} eq "debit" ) {
		$self->{type} = "1";
	}
	else {
		$self->{type} = "2";
		carp "You did not choose the type of the DTA file.";
		return 0;
	}
	if ( $file && !$self->_setAccount($file) ) {
		carp "Setting up sender account failed.";
		return 0;    # Setup acoount file sender failed!!
	}
	return $self;
}

#****s*	_setAccount
#
#	DESCRIPTION
#		Speichern der Accountdaten des Kontoinhabers im Objekt
#
#	PARAMETER
#		%file		optional: Accountfile des Kontoinhabers
#
#	RETURN
#		Objekt im Erfolgsfall, 0 wenn Fehlgeschlagen
#
#******************************************************************************
sub _setAccount {
	my $self = shift;
	my $file = shift;

	if ( $file && length( $file->{name} ) > 0 ) {
		if ( !$self->_validNumeric( $file->{bank_code} ) ) {
			carp "Please provide a valid sender BLZ.";
			return 0;    # Fehlerhafte Bankleitzahl
		}
		if ( !$self->_validNumeric( $file->{account_number} ) ) {
			carp "Please provide a valid sender account-number.";
			return 0;    # Fehlerhafte Kontonummer
		}
		if ( !$file->{additional_name} || length( $file->{additional_name} ) == 0 ) {
			$file->{additional_name} = '';    # additional_name setzen, wenn nicht angegeben
		}
		$self->{account} = {
			"name"            => substr( $self->_makeValidString( $file->{name} ),            0, 27 ),
			"bank_code"       => $file->{bank_code},
			"account_number"  => $file->{account_number},
			"additional_name" => substr( $self->_makeValidString( $file->{additional_name} ), 0, 27 )
		};
		return $self;
	}
	else {
		croak "No sender account defined.";
		return 0;                             # Account Name oder Parameter fehlt!
	}
}

#****s*	addExchange
#
#	DESCRIPTION
#		Hinzufügen eines Bankauftrags
#
#	PARAMETER
#		%receiver		Empfänger bei Gutschrift,
#                                       bzw. Lastschrift (Einzug von)
#
#		$amount			Betrag der Zahlung in Euro z.B. 100.50
#
#		$purposes		Verwendungszweck: Einfacher String oder List mit zwei Strings
#		%sender			optional: Accountdaten des Kontoinhabers
#
#	EXAMPLE
#		$dta->addExchange({
#			name			=>	'Mustermann',
#			bank_code		=>	'10120900',
#			account_number	=>	'1029384756',
#			},112.45,["Kundennr: 16389176","Zeitraum: 7/06-9/06"]);
#
#	RETURN
#		Objekt im Erfolgsfall, 0 wenn Fehlgeschlagen
#
#******************************************************************************
sub addExchange {
	my $self     = shift;
	my $receiver = shift;
	my $amount   = shift;
	my $purposes = shift;
	my $sender   = shift;
	my $exchange = {};

	if ( !$receiver->{additional_name} ) {
		$receiver->{additional_name} = '';
	}
	foreach my $member qw(name bank_code account_number additional_name) {
		if ( !$sender || !$sender->{$member} ) {
			$sender->{$member} = $self->{account}{$member};
		}
	}
	$exchange->{receiver} = $receiver;
	$exchange->{sender}   = $sender;

	foreach my $account qw(sender receiver) {
		if ( !$exchange->{$account}{name} || length( $exchange->{$account}{name} ) == 0 ) {
			carp "Please provide a valid $account name.";
			return 0;
		}
		$exchange->{$account}{name} = substr( $self->_makeValidString( $exchange->{$account}{name} ), 0, 27 );

		if ( !$exchange->{$account}{bank_code} || !$self->_validNumeric( $exchange->{$account}{bank_code} ) ) {
			carp "Please privide a valid $account bank code.";
			return 0;
		}
		if (   !$exchange->{$account}{account_number}
			|| !$self->_validNumeric( $exchange->{$account}{account_number} ) )
		{
			carp "Please provide a valid $account account number.";
			return 0;
		}
		$exchange->{$account}{additional_name} =
		  substr( $self->_makeValidString( $exchange->{$account}{additional_name} ), 0, 27 );
	}
	unless($amount){
		carp "Please check the amount of the transaction.";
		return 0;
	}
	$amount =~ s/,/\./g;
	$exchange->{amount} = sprintf( "%.02f", $amount ) * 100;# if $amount && $amount > 0;

	if ( !ref($purposes) ) {
		$purposes = [ $purposes, '' ];
	}
	my $length = @$purposes;
	for ( my $i = 0 ; $i < $length ; ++$i ) {
		if ( $purposes->[$i] ) {
			$purposes->[$i] = substr( $self->_makeValidString( $purposes->[$i] ), 0, 27 );
		}
	}
	$exchange->{purposes} = $purposes;

	push( @{ $self->{exchanges} }, $exchange );
	$self->{amount} += $amount if $amount && $amount > 0;
	$self->{items}++;
	$self->{sum_accounts}   += $exchange->{receiver}{account_number};
	$self->{sum_bank_codes} += $exchange->{receiver}{bank_code};

	return $self;
}

#****s*	getContent
#
#	DESCRIPTION
#		Abruf der DTAUS Daten. Formatieren einer DTAUS0.txt Datensequenz.
#
#	PARAMETER
#		$execday		optional: Zeitpunkt des Transfers
#                                       Format: DD.MM.[YY]YY oder YYYY-MM-DD
#
#	RETURN
#		String mit den DTAUS Daten der Transaktionen
#
#******************************************************************************
sub getContent {
	my $self = shift;
	my $execday = shift;
	my $text;

	my $sum_account_numbers = 0;
	my $sum_bank_codes      = 0;
	my $sum_amounts         = 0;
	my $num_exchanges       = 0;

	## data record A

	# record length (128 Bytes)
	$text .= sprintf( "%04s", 128 );

	# record type
	$text .= "A";

	# file mode (credit or debit)
	$text .= ( $self->{type} == 0 ) ? "G" : "L";

	# Customer File ("K") / Bank File ("B")
	$text .= "K";

	# sender's bank code
	$text .= sprintf( "%08s", $self->{account}{bank_code} );

	# only used if Bank File, otherwise NULL
	$text .= sprintf( "%08s", "" );

	# sender's name
	$text .= sprintf( "%- 27s", $self->{account}{name} );

	# date of file creation
	$text .= strftime( "%d%m%y", localtime( $self->{timestamp} ) );

	# free (bank internal)
	$text .= sprintf( "% 4s", "" );

	# sender's account number
	$text .= sprintf( "%010s", $self->{account}{account_number} );

	# sender's reference number (optional)
	$text .= sprintf( "%010s", "" );

	# free (reserve)
	$text .= sprintf( "% 15s", "" );

	# execution date
	$execday = strftime("%d.%m.%Y", localtime( $self->{timestamp} ))
	    unless $execday && length($execday);
	my @dayvec = split /\./,$execday;           # DD.MM.YYYY
	if ($execday =~ m|-|) {
	    @dayvec = reverse(split /-/, $execday); # YYYY-MM-DD
	}
	$dayvec[2] -= 1900 unless $dayvec[2] < 1900;
	my $exectime = timelocal(0,0,12,$dayvec[0],$dayvec[1] - 1,$dayvec[2]);
	if($exectime <= $self->{timestamp} - 12 * 60 * 60 ||
	    $exectime > $self->{timestamp} + 365 * 24 * 60 * 60) {
	    carp "The date you provided is not plausible. Please double check results!";
	}
	# set execution date ("DDMMYYYY", optional)
	$text .= sprintf( "% 8s", strftime( "%d%m%Y", localtime($exectime) ));

	# free (reserve)
	$text .= sprintf( "% 24s", "" );

	# currency (1 = Euro)
	$text .= "1";

	foreach my $exchange ( @{ $self->{exchanges} } ) {
		## data record(s) C

		$sum_account_numbers += $exchange->{receiver}{account_number};
		$sum_bank_codes      += $exchange->{receiver}{bank_code};
		$sum_amounts         += $exchange->{amount};
		$num_exchanges       += 1;

		my @additional_purposes     = @{ $exchange->{purposes} };
		my $first_purpose           = shift(@additional_purposes);
		my @additional_parts        = ();
		my $additional_parts_number = @additional_parts;

		if ( length( $exchange->{receiver}{additional_name} ) > 0 ) {
			push(
				@additional_parts,
				{
					type => "01",
					data => $exchange->{receiver}{additional_name},
				}
			);
			$additional_parts_number = @additional_parts;
		}
		foreach my $additional_purpose (@additional_purposes) {
			push(
				@additional_parts,
				{
					type => "02",
					data => $additional_purpose,
				}
			);
			$additional_parts_number = @additional_parts;
		}
		if ( length( $exchange->{sender}{additional_name} ) > 0 ) {
			push(
				@additional_parts,
				{
					type => "03",
					data => $exchange->{sender}{additional_name},
				}
			);
			$additional_parts_number = @additional_parts;
		}

		my $data;

		# record length (187 Bytes + 29 Bytes for each additional part)
		$data .= sprintf( "%04d", 187 + $additional_parts_number * 29 );

		# record type
		$data .= "C";

		# first involved bank
		$data .= sprintf( "%08s", $exchange->{sender}{bank_code} );

		# receiver's bank code
		$data .= sprintf( "%08s", $exchange->{receiver}{bank_code} );

		# receiver's account number
		$data .= sprintf( "%010s", $exchange->{receiver}{account_number} );

		# internal customer number (11 chars) or NULL
		$data .= "0" . sprintf( "%011s", "" ) . "0";

		# payment mode (text key)
		$data .= ( $self->{type} == 0 ) ? "51" : "05";

		# additional text key
		$data .= "000";

		# bank internal
		$data .= " ";

		# free (reserve)
		$data .= sprintf( "%011s", "" );

		# sender's bank code
		$data .= sprintf( "%08s", $exchange->{sender}{bank_code} );

		# sender's account number
		$data .= sprintf( "%010s", $exchange->{sender}{account_number} );

		# amount
		$data .= sprintf( "%011s", $exchange->{amount} );

		# free (reserve)
		$data .= sprintf( "% 3s", "" );

		# receiver's name
		$data .= sprintf( "%- 27s", $exchange->{receiver}{name} );

		# delimitation
		$data .= sprintf( "% 8s", "" );

		# sender's name
		$data .= sprintf( "%- 27s", $exchange->{sender}{name} );

		# first line of purposes
		$data .= sprintf( "%- 27s", $first_purpose );

		# currency (1 = Euro)
		$data .= "1";

		# free (reserve)
		$data .= sprintf( "% 2s", "" );

		# amount of additional parts
		$data .= sprintf( "%02d", $additional_parts_number );

		if ( $additional_parts_number > 0 ) {
			my $part;
			for ( my $index = 1 ; $index <= 2 ; $index++ ) {
				my $additional_part;
				if ( $additional_parts_number > 0 ) {
					$additional_part         = shift(@additional_parts);
					$additional_parts_number = @additional_parts;
				}
				else {
					$additional_part = {
						type => "  ",
						data => ""
					};
				}

				# type of addional part
				$part .= $additional_part->{type};

				# additional part content
				$part .= sprintf( "%- 27s", $additional_part->{data} );
			}

			# delimitation
			$part .= sprintf( "% 11s", "" );
			$data .= $part;
		}

		for ( my $part = 3 ; $part <= 5 ; $part++ ) {
			my $more;
			if ( $additional_parts_number > 0 ) {
				for ( my $index = 1 ; $index <= 4 ; $index++ ) {
					my $additional_part;
					if ( $additional_parts_number > 0 ) {
						$additional_part         = shift(@additional_parts);
						$additional_parts_number = @additional_parts;
					}
					else {
						$additional_part = {
							type => "  ",
							data => ""
						};
					}

					# type of addional part
					$more .= $additional_part->{type};

					# additional part content
					$more .= sprintf( "%- 27s", $additional_part->{data} );
				}

				# delimitation
				$more .= sprintf("% 12s");
				$data .= $more;
			}
		}

		#		print "ap=$additional_parts_number=\n".encode_entities(Dumper($data))."";
		$text .= $data;
	}

	## data record E

	# record length (128 bytes)
	$text .= sprintf( "%04d", 128 );

	# record type
	$text .= "E";

	# free (reserve)
	$text .= sprintf( "% 5s", "" );

	# number of records type C
	$text .= sprintf( "%07s", $num_exchanges );

	# free (reserve)
	$text .= sprintf( "%013s", "" );

	# sum of account numbers
	$text .= sprintf( "%017s", $sum_account_numbers );

	# sum of bank codes
	$text .= sprintf( "%017s", $sum_bank_codes );

	# sum of amounts
	$text .= sprintf( "%013s", $sum_amounts );

	# delimitation
	$text .= sprintf( "% 51s", "" );

	return $self->{text} = $text;
}

#****s*	_validChar
#
#	DESCRIPTION
#		überprüfen auf gültiges DTAUS Zeichen
#
#	PARAMETER
#		$char		zu überprüfendes Zeichen
#
#	RETURN
#		1 wenn gültig, 'undef' wenn ungültig
#
#******************************************************************************
sub _validChar {
	my $self = shift;
	my $char = ord(shift);

	return $self->{_validChars}{"$char"};
}

#****s*	_validString
#
#	DESCRIPTION
#		Überprüfen auf gültige DTAUS Zeichen im String.
#
#	PARAMETER
#		$string		zu überprüfende Zeichenkette
#
#	RETURN
#		1 wenn gültig, 0 wenn ungültig
#
#******************************************************************************
sub _validString {
	my $char;
	my $self   = shift;
	my $string = shift;
	foreach $char ( split //, $string ) {
		if ( !$self->_validChar($char) ) {
			return 0;
		}
	}
	return 1;
}

#****s*	_validNumeric
#
#	DESCRIPTION
#		Überprüfen ob gültige Zahl.
#
#	PARAMETER
#		$string		zu überprüfende Zeichenkette
#
#	RETURN
#		1 wenn gültig, 0 wenn ungültig
#
#******************************************************************************
sub _validNumeric {
	my $self   = shift;
	my $string = shift;

	return ( $string =~ m/^[0-9]+$/ ) ? 1 : 0;
}

#****s*	_makeValidString
#
#	DESCRIPTION
#		Umwandeln oder entfernen ungültiger Zeichen.
#
#	PARAMETER
#		$string		zu behandelnde Zeichenkette
#
#	RETURN
#		Umgewandelte Zeichenkette
#
#******************************************************************************
sub _makeValidString {
	my $char;
	my $self   = shift;
	my $string = shift;
	my $result = '';

	$string =~ s/Ä/Ae/;
	$string =~ s/Ö/Oe/;
	$string =~ s/Ü/Ue/;
	$string =~ s/ä/ae/;
	$string =~ s/ö/oe/;
	$string =~ s/ü/ue/;
	$string =~ s/ß/ss/;
	$string = uc($string);

	foreach $char ( split //, $string ) {
		$result .= ( $self->_validChar($char) ) ? $char : ' ';
	}

	return $result;
}

sub amount {
	my $self = shift;

	return $self->{amount};
}

sub items {
	my $self = shift;

	return $self->{items};

}

sub sum_accounts {
    my $self = shift;
    return $self->{sum_accounts};
}

sub sum_bank_codes {
    my $self = shift;
    return $self->{sum_bank_codes};
}

__END__