Forum OpenACS Q&A: Re: DTAUS code - someone got it?
Once upon a time, I implemented a DTAUS module for a computer gaming online service. Back in those days, one had enough time to choose a nice language and do literate programming. Hope this helps (please ignore the crappy SQL - it was one of my first database programs):
dta.ml: Belegloser Datenträgeraustausch
Das Programm DTA wertet die Account-Datenbank aus und erzeugt Lastschriften, die gemäß dem Disketten-Clearing-Verfahren (Datenträgeraustausch zwischen Kunde und Bank) kodiert werden. Die Definition des Formats wurde einer Broschüre des Bank-Verlag Köln entnommen (Bestellnr. 22.187, Stand August 1997).
Die Änderungen, die das Programm an der Datenbank vornimmt, sind nicht
destruktiv, lassen sich also leicht rückgängig machen. Die Buchungen werden
in einer DTA-Datei und der Tabelle dta gespeichert. Der
Kontostand der User wird zunächst nicht geändert; dies geschieht erst, wenn
später die Zahlungseingänge von Hand eingegeben werden.
<dta.ml>= (* dta.ml Automatically generated by notangle from file $Id: dta.ml.nw,v 1.15 1999/12/17 20:08:39 cc Exp $ *) open List;; open String;; open Str;; open Printf;; open Unix;; open Num;; open Library;; open Sql;; open Postgres;; (*Configuration*) let ourName = rpad "COMPANY NAME" len:27 fill:' ';; let ourCity = "82319 Starnberg";; let ourBank = "Bayerische Vereinsbank";; let ourBLZ = "70020270";; let ourAccount = 12345678;; let dtaPath = "/usr/local/apache/htdocs/UserAdmin/DTA/";; let credit = true;; let minAmount = if credit then 1.00 else 3.00;; let userdb = setdb "userdb";; exec_cmd userdb "BEGIN";; <misc> <record a> <record c> <record e> <begleitzettel> <main>
--------------------------------------------------------------------
Datensatz A
Der Datensatz A enthält den Diskettenabsender und -empfänger; er ist je logischer Datei nur einmal vorhanden. Die Länge des Datensatzes A ist auf 128 Bytes beschränkt.
<record a>=
(*Datenträger-Vorsatz*)
let record_a =
(*Erstellungsdatum*)
let now = localtime (time())
in let creationDate =
sprintf "%02d" now.tm_mday ^
sprintf "%02d" (now.tm_mon+1) ^
sprintf "%02d" (now.tm_year mod 100)
in
"0128" ^ (*Satzlänge*)
"A" ^ (*Satzart*)
(if credit then "G" else "L") ^ (*Gutschrift bzw Lastschrift*)
"K" ^ (*Kundendiskette*)
ourBLZ ^
"00000000" ^ (*Null*)
ourName ^ (*Kundenname*)
creationDate ^ (*Diskettenerstellungsdatum (TTMMJJ)*)
" " ^ (*Leerzeichen*)
sprintf "%010d" ourAccount ^ (*Kontonr. des Kunden*)
refNo ^ (*Referenznr. des Einreichers*)
make len:15 fill:' ' ^ (*Leerzeichen*)
make len:8 fill:' ' ^ (*Ausführungsdatum*)
make len:25 fill:' ';; (*Leerzeichen*)
if length record_a <> 128 then
(exec_cmd userdb "ABORT";
failwith ("Record A has wrong length " ^
string_of_int (length record_a)))
else ();;
--------------------------------------------------------------------
Datensatz C
Der Datensatz C enthält Einzelheiten über die auszuführenden Aufträge. Er gliedert sich in einen konstanten und einen variablen Teil. Der Datensatz C muß jeweils mit einem neuen Satzabschnitt beginnen.
<record c>=
(*Zahlungsaustauschsatz*)
let make_record_c :customerID :customerName :customerBLZ :customerAccount
:amount =
if length customerName > 27 then invalid_arg "make_record_c: customerName"
else
let customerBLZ' = lpad len:8 fill:'0' (string_of_num customerBLZ)
and customerAccount' = lpad len:10 fill:'0' (string_of_num customerAccount)
in
"0187" ^ (*Satzlänge*)
"C" ^ (*Satzart*)
make len:8 fill:'0' ^ (*erstbeteiligtes Institut (optional)*)
customerBLZ' ^ (*BLZ der Zahlstelle*)
customerAccount' ^ (*Kontonr. des Zahlungspflichtigen*)
make len:13 fill:'0' ^ (*interne Kundennr.*)
(if credit then "51" else "05") ^ (*Überweisung bzw. Lastschrift*)
"000" ^
" " ^ (*Leerzeichen*)
sprintf "%011d" amount ^ (*Betrag*)
ourBLZ ^ (*BLZ erstbeauftragtes Institut*)
sprintf "%010d" ourAccount ^ (*Kontonr. Zahlunsempfänger*)
make len:11 fill:'0' ^ (*Reserve bis Stufe 3 der EWWU*)
" " ^ (*Reserve*)
uppercase customerName ^ make len:(27 - length customerName) fill:' ' ^
(*Name Zahlungspflichtiger*)
make len:8 fill:' ' ^ (*Abgrenzung*)
ourName ^ (*Name Zahlungsempfänger*)
rpad ("KUNDENNR. "^customerID) len:27 fill:' ' ^
(*Verwendungszweck*)
" " ^ (*Reserve*)
"00" ^ (*Erweiterungszeichen*)
make len:69 fill:' ';;
--------------------------------------------------------------------
Datensatz E
Der Datensatz E dient der Abstimmung; er ist je logischer Datei nur einmal vorhanden.
<record e>= (*Datenträger-Nachsatz*) let make_record_e :recordCount :amountTotal :accountSum :blzSum = let amountTotal = string_of_num amountTotal and accountSum = string_of_num accountSum and blzSum = string_of_num blzSum in "0128" ^ (*Satzlänge*) "E" ^ (*Satzart*) " " ^ (*Reserve*) sprintf "%07d" recordCount ^ (*Anzahl der Datensätze C*) lpad len:13 fill:'0' amountTotal ^(*Summe der Beträge aus den Datensätzen C*) lpad len:17 fill:'0' accountSum ^ (*Summe der Kontonummern*) lpad len:17 fill:'0' blzSum ^ (*Summe der Bankleitzahlen*) make len:13 fill:'0' ^ make len:51 fill:' ';;
--------------------------------------------------------------------
Berechnung der Last- bzw. Gutschriften
Zuerst fragen wir die Datenbank ab und speichern die Infos in der
Tabelle tmp_collection. Die einzige Besonderheit dabei
ist der Name des Kontoinhabers. Wenn bei den Bank-Infos ein Name
angegeben ist, wird dieser benutzt, ansonsten der Name des Users.
<main>=
(*Kontostand für alle User berechnen.*)
exec_cmd userdb
(str_select from:"acc_deposit"
fields:["accountID"; "assets+credit+debt AS balance"]
into:"tmp_balance");;
(*Ausstehende DTA-Buchungen zum Kontostand hinzurechnen (um doppelte
Abbuchungen zu verhindern).*)
exec_cmd userdb
(str_select from:"dta"
into:"tmp_dta"
fields:["accountID"; "sum(amount) AS amount"]
groupby:"accountID");;
exec_cmd userdb
(update table:"tmp_balance"
values:[ ("balance", "balance + amount") ]
from:"tmp_dta"
where:"tmp_balance.accountID=tmp_dta.accountID");;
exec_cmd userdb "DROP TABLE tmp_dta";;
(*Die löschen, die zu wenig Schulden haben oder von denen wir keine
Bankeinzugsermächtigung haben.*)
let where =
if credit then
"balance < '" ^ string_of_float minAmount ^ "' OR " ^
"accountID IN (SELECT accountID FROM account WHERE accountClass >= 100)"
else
"balance > '" ^ string_of_float (-.minAmount) ^ "' OR " ^
"accountID IN (SELECT accountID FROM account WHERE deactivated = true)"
in exec_cmd userdb (delete from:"tmp_balance" :where);;
(*Bankkonto*)
exec_cmd userdb
(str_select from:"tmp_balance, acc_collection"
into:"tmp_collection"
fields:[ "acc_collection.accountID"; "trim(holder) AS holder";
"BLZ"; "trim(bankAccount) AS bankAccount"; "balance" ]
where:"tmp_balance.accountID = acc_collection.accountID");;
exec_cmd userdb
(delete from:"tmp_balance"
where:"accountID IN (SELECT accountID FROM acc_collection)");;
if credit then
exec_cmd userdb
("INSERT INTO tmp_collection " ^
str_select from:"tmp_balance, acc_refund"
fields:[ "acc_refund.accountID"; "trim(holder) AS holder";
"BLZ"; "trim(bankAccount) AS bankAccount"; "balance" ]
where:"tmp_balance.accountID = acc_refund.accountID")
else ();;
exec_cmd userdb "DROP TABLE tmp_balance";;
(*Kontoinhaber*)
exec_cmd userdb
(update table:"tmp_collection"
values:[ ("holder", "textcat(givenName, textcat(' ', surname))") ]
from:"account"
where:"holder IS NULL AND tmp_collection.accountID=account.accountID");;
Nun werden die Daten aus der temporären Tabelle ausgelesen, in
C-Datensätze konvertiert und in der Tabelle dta gespeichert.
<main>+=
let rec collect (amountTotal, accountSum, blzSum) result = function
[ Some accountID; Some customerName; Some blz; Some account;
Some balance ] :: rs ->
let customerID = customerID_of_accountID accountID
and amount =
(if credit then i else (~-)) (Globals.money_of_string balance)
and customerAccount =
try num_of_string account
with Failure _ -> failwith ("num_of_string "^account)
and customerBLZ =
try num_of_string blz
with Failure _ -> failwith ("num_of_string "^blz)
in let record_c =
make_record_c :customerID :customerName :customerBLZ
:customerAccount :amount
in if length record_c <> 256 then
failwith ("Record C has wrong length " ^
string_of_int (length record_c) ^
": \n" ^ record_c)
else ();
exec_cmd userdb
(insert into:"dta"
values:[ accountID;
quote (Globals.string_of_money
((if credit then (~-) else i) amount));
quote customerName; quote account; quote blz;
"'"^refNo^"'"; "'now'" ]);
collect (amountTotal +/ (num_of_int amount),
accountSum +/ customerAccount,
blzSum +/ customerBLZ)
(result^record_c) rs
| [] -> ((amountTotal, accountSum, blzSum), result)
| _ -> invalid_arg "collect";;
let records = select userdb from:"tmp_collection";;
exec_cmd userdb "DROP TABLE tmp_collection";;
(*Abbrechen, wenn keine Buchungen erzeugt wurden.*)
if null records then (exec_cmd userdb "ABORT"; exit 1)
else ();;
let ((amountTotal, accountSum, blzSum), records_c) =
collect (Int 0, Int 0, Int 0) "" records;;
let record_e =
make_record_e recordCount:(List.length records) :amountTotal :accountSum
:blzSum;;
if length record_e <> 128 then
(exec_cmd userdb "ABORT";
failwith ("Record E has wrong length " ^
string_of_int (length record_e)))
else ();;
let dtaus = open_out file:(dtaPath^refNo^".dta");;
output_string (record_a ^ records_c ^ record_e) to:dtaus;;
close_out dtaus;;
let sheet = open_out file:(dtaPath^refNo^".html");;
output_string (get_sheet recordCount:(List.length records)
amountTotal:(float_of_num amountTotal /. 100.0)
:accountSum :blzSum) to:sheet;;
close_out sheet;;
exec_cmd userdb "END";;
--------------------------------------------------------------------
Begleitzettel
Jeder Diskette muß ein Begleitzettel beiliegen, der Informationen über den Inhalt der Diskette enthält. Dieser Zettel wird hier als HTML-Datei erzeugt, die dann unter Windows ausgedruckt werden kann.
<begleitzettel>=
let format_num i =
let thousand = num_of_int 1000
in let rec format i result =
if i </ thousand then
string_of_num i ^ (if result = "" then "" else "." ^ result)
else
let result' =
sprintf "%03d" (int_of_num (mod_num i thousand)) ^
(if result <> "" then "." else "") ^
result
in format (floor_num (i // thousand)) result'
in format i "";;
let format_float f =
global_replace (regexp "\\.") with:"," in:(string_of_float f);;
let get_sheet :recordCount :amountTotal :accountSum :blzSum =
let make_row (c1, c2) =
"<tr><td>"^c1^"</td><td align=\"right\">"^c2^"</td></tr>"
and now = localtime (time())
in let date =
sprintf "%02d.%02d.%4d" now.tm_mday (now.tm_mon+1) (now.tm_year + 1900)
in
"<html><head><title>Begleitzettel</title></head>" ^
"<body bgcolor=\"#FFFFFF\"><h1>Begleitzettel</h1>" ^
"<h2>Belegloser Datenträgeraustausch</h2>" ^
"<table border=\"0\" width=\"100%\">" ^
concat sep:"\n"
(map fun:make_row
[ ("Sammel" ^
(if credit then "überweisungs" else "einziehungs") ^
"auftrag an", ourBank);
(" ", " ");
("Name der Datenträgeraustausch-Datei:", "DTAUS1");
("Verwendeter Datenträger:", "MS-DOS 1.44 MB");
("Erstellungsdatum:", date);
(" ", " ");
("Anzahl der Datensätze C:", string_of_int recordCount);
("Summe DM:", format_float amountTotal);
("Kontrollsumme Kontonummern:", format_num accountSum);
("Kontrollsumme Bankleitzahlen:", format_num blzSum);
(" ", " ");
("Absender:", " ");
("Name", "Company Name");
("Bankleitzahl", ourBLZ);
("Kontonummer", string_of_int ourAccount) ]) ^
"</table><p>"^ourCity^", "^date^"</p><p> </p>" ^
"<p>_______________________________________</p>" ^
"<p>Unterschrift</p>" ^
"<p style=\"font-size: smaller\">(Sicherungsdatei beim Absender: " ^ refNo ^
")</p></body></html>";;
--------------------------------------------------------------------
Misc.
<misc>=
(*accountID in customerID konvertieren (durch Addition von 100.000).*)
let customerID_of_accountID id =
if length id > 5 then invalid_arg "customerID_of_accountID"
else "1" ^ make len:(5 - length id) fill:'0' ^ id;;
(*Referenznr. berechnen*)
let refNo =
let (lastDate, lastIdx, thisDate) =
match select userdb from:"billing_config"
fields:["dval"; "ival"; "'now'::date"]
where:"label='last_dta'" update:true with
[[Some date; Some idx; Some today]] -> (date, int_of_string idx, today)
| _ -> failwith "record_a: select last_dta"
in let thisIdx = if lastDate = thisDate then lastIdx + 1 else 1
in exec_cmd userdb
(update table:"billing_config"
values:[("dval", "'"^thisDate^"'"); ("ival", string_of_int thisIdx)]
where:"label='last_dta'");
sub thisDate pos:6 len:4 ^ sub thisDate pos:0 len:2 ^
sub thisDate pos:3 len:2 ^ sprintf "%02d" thisIdx;;
$Id: dta.ml.nw,v 1.15 1999/12/17 20:08:39 cc Exp $
