[Mpls-pm] Useful prolog

Joshua ben Jore twists at gmail.com
Thu Jan 12 08:10:11 PST 2006


Last night, someone asked me why I was using prolog at work and I gave
a complete hash of an answer and couldn't find the code which
demonstrated how nice it is for some problems. In this case, it's a
script to compare data from two databases on two different servers and
complain about any irregularities. Prolog was especially nice here
because I could just describe the error conditions and all of the
looping and matching was more implicit that not. It kept the code
succinct and focused on the problem which was detecting
irregularities.

This is checking data synchronization between one database and
another. In a better world this might be handled with some kind of
relational constraints or triggers but I'm stuck checking up after a
scheduled program which does this stuff manually. If or when I write
something that will escape ~/bin, it won't be in prolog because no one
else on my team does. It was just the best tool for the job at that
particular moment.

If someone knows of a nice perl module for doing this kind of thing
I'd be glad to hear of it. Perhaps DBD::AnyData.

Josh

######################################################################
#		      ~/bin/selfpay-synch-pmt.sh
######################################################################
#!/bin/bash

if [ $# -ne 3 ]; then
  echo 'Usage: server findb clt_id'
  exit 1
fi

cat > pmt.pro <<PROLOG
#!/usr/bin/swipl -q -g main -s
main :-
	check,halt.

check :-
	check_amt,
	check_ent,
	check_self2fin,
	check_fin2self.

check_amt :-
	forall(entusrpmt(P,_,T2,_),
	check_amt(P,T2)).
check_amt(P,T2) :-
	P > 0,
	pmt(P,E,T1),
	not(pendpmt(P,E,_)),
	D is abs( T1 - T2 ),
	D >= 0.01,
	write('Mismatch amt: ENT_ID='),write(E),
	write(' PMT_ID='),write(P),
	write(' '),write(T1),
	write(' - '),write(T2),
	write(' = '),writeln(D).
check_amt(P,T2) :-
	P > 0,
	pmt(P,E,0),
	pendpmt(P,E,T1),
	D is abs( T1 - T2 ),
	D >= 0.01,
	write('Mismatch pend amt: ENT_ID='),write(E),
	write(' PMT_ID='),write(P),
	write(' '),write(T1),
	write(' - '),write(T2),
	write(' = '),writeln(D).	

check_ent :-
	forall(entusrpmt(P,E,_,_),
	       check_ent(P,E)).
check_ent(P,E1) :-
	pmt(P,E2,_),
	E1 \= E2,
	write('Mismatch ENT_ID: PMT_ID='),write(P),
	write(' '),write(E1),
	write(' != '),writeln(E2).
check_ent(_,_).

check_self2fin :-
	forall(entusrpmt(E,P,T,A),
	       check_self2fin2(E,P,T,A)).
check_self2fin2(P,E,T,A) :-
	not(pmt(P,_,_)),
	write('Missing bennet pmt: ENT_ID='),write(E),
	write(' PMT_ID='),write(P),
	write(' TOTAL_AM='),write(T),
	write(' ACCEPT_AM='),writeln(A).
check_self2fin2(_,_,_,_).

check_fin2self :-
	forall(pmt(P,E,T),
	check_fin2self2(P,E,T)).
check_fin2self2(P,E,T) :-
	not(entusrpmt(P,_,_,_)),
	write('Missing selfpay pmt: ENT_ID='),write(E),
	write(' PMT_ID='),write(P),
	write(' TRANS_AM='),writeln(T).
check_fin2self2(_,_,_).		%entusrpmt(P,_,_,_).

% Data follows
PROLOG

echo pmt...
cat <<EOF | dump-query -s $1 -d $2 2>/dev/null |
/home/jbenjore/bin/dump-to-prolog pmt >> pmt.pro
select PMT.PMT_ID,ENT_ID,sum(TRANS_AM)
from PMT,PMTDBT
where PMT.PMT_ID=PMTDBT.PMT_ID
group by PMT.PMT_ID
EOF


echo pendpmt...
cat <<EOF | dump-query -s $1 -d $2 2>/dev/null |
/home/jbenjore/bin/dump-to-prolog pendpmt >> pmt.pro
select PMT.PMT_ID,ENT_ID,TRANS_AM
from PMT,PMTDBT
where PMT.PMT_ID = PMTDBT.PMT_ID
  and PMTDBT.PMTDBTADJ_CD = 2
EOF


echo entusrpmt...
cat <<EOF | dump-query -s DB0 -d SELFPAY 2>/dev/null |
/home/jbenjore/bin/dump-to-prolog entusrpmt >> pmt.pro
select PMT_ID,ENT_ID,TOT_AM,ACCEPT_AM
from ENTUSR,ENTUSRLNK,ENTUSRPMT
where CLT_ID=$3
  and ENTUSR.ENTUSR_ID=ENTUSRLNK.ENTUSR_ID
  and ENTUSRLNK.ENTUSRLNK_ID=ENTUSRPMT.ENTUSRLNK_ID
EOF

chmod +x pmt.pro
echo 'Done! Run "./pmt.pro"'

######################################################################
#			 ~/bin/dump-to-prolog
######################################################################

#!/usr/bin/perl
my $name = lcfirst shift
    or die "Usage: $0 clause-name\n";
@ARGV = ();

while (<>) {
    next
        if $. == 1;

    chomp;
    s/'/''/g;
    s{
      # Find a place that is preceded by the beginning of the string or a tab
      (?:
         (?<=\t)
         |
         (?<=^)
      )

      # Only non-numbers are to be escaped.
      (?!-?(?:\d+(?:\.\d+)?|0?\.\d+))

      # Capture everything up to the next delimiter or end of string.
      ([^\t]*)

     }
     {'$1'}gx;
    tr/\t/,/;

    print "$name($_).\n";
}


More information about the Mpls-pm mailing list