Source code to database access implementation.

/*****************************************************************************

		Copyright (c) My Company

 Project:  LICENSE
 FileName: DATABASE.PRO
 Purpose: No description
 Written by: Visual Prolog
 Comments:
******************************************************************************/

include "license.inc"
include "database.pre"

facts - licenses
  single idcounter(unsigned)
  nocopy software_db(softwareId,string SoftwareName,integer NoOfLicenses,parmList)
  nocopy user_db(userId,string UserName,parmList)
  license_db(userId,softwareId)

clauses
  idcounter(0).

/******************************************************************************
	Sorting during backtracking !
******************************************************************************/
domains
 user = struct e(userId,string UserName)
 userL = user*
 software = struct e(softwareId,string SoftwareName)
 softwareL = software*

predicates
  nondeterm retsorted(userL,User)-(i,e(o,o))
  nondeterm retsorted(softwareL,software)-(i,e(o,o))

  nondeterm retsorted(user,userL,userL,User)-(i,i,i,e(o,o))
  nondeterm retsorted(software,softwareL,softwareL,software)-(i,i,i,e(o,o))

  procedure split(user, userL,userL,userL)-(i,i,o,o)
  procedure split(software, softwareL,softwareL,softwareL)-(i,i,o,o)

clauses
  split (_,[],[],[]).
  split (X,[Y|T],[Y|Less],Greater) :-
   	X = e(_,NameX), upper_lower(NameX,SX),
   	Y = e(_,NameY), upper_lower(NameY,SY),
   	SX > SY,!,
   	split (X,T,Less,Greater).
  split(X,[Y|T],Less,[Y|Greater]) :-
   	split (X,T,Less,Greater).

  retsorted([H|T],RetElem):-		% First split the list
   	split(H,T,Less,Greater),
   	retsorted(H,Less,Greater,RetElem).

  retsorted(_,Less,_,RetElem):-		% Then first return all that are smaller
	retsorted(Less,RetElem).
  retsorted(H,_,_,H).			% and Return the >middle Elem<
  retsorted(_,_,Greater,RetElem):-	% and finally return Elems that are greather
	retsorted(Greater,RetElem).

/******************************************************************************
	Count the lenght of a list
******************************************************************************/
domains
  userlist = userId*
predicates
  list_len(userlist,integer Len)
clauses
  list_len([],0).
  list_len([_|T],Len):-
	list_len(T,TailLen),
	Len=TailLen+1.

/******************************************************************************
	Load and save of the database
******************************************************************************/
facts - dbfilename
  determ dbfilename(string DBFileName)

clauses
  db_save():-
	dbfilename(DBFileName),!,
	save(DBFileName,licenses).
  db_save():-
	errorexit().

  db_load(DBFileName):-
	consult(DBFileName,licenses),
	assert(dbfilename(DBFileName)).


/******************************************************************************
	Small Helping predicates
******************************************************************************/

predicates
  nondeterm software_elems(software)-(o)
  nondeterm user_elems(user)-(o)
  nondeterm software_user_elems(softwareId,user)-(i,o)
  nondeterm user_software_elems(userId,software)-(i,o)
  procedure count_licenses(softwareId,integer UsedNoOfLicenses)
  procedure check_license_problem(softwareId,string LicenseProblem)-(i,o)

clauses
  software_elems(e(Id,Name)):-
	software_db(Id,Name,_,_).

  user_elems(e(Id,Name)):-
	user_db(Id,Name,_).

  software_user_elems(SoftwareId,e(UserId,UserName)):-
	license_db(UserId,SoftwareId),
	user_db(UserId,UserName,_).

  user_software_elems(UserId,e(SoftwareId,SoftwareName)):-
	license_db(UserId,SoftwareId),
	software_db(SoftwareId,SoftwareName,_,_).

  count_licenses(SoftwareId,UsedNoOfLicenses):-
	findall(UserId,license_db(UserId,SoftwareId),List),
	list_len(List,UsedNoOfLicenses).

  check_license_problem(SoftwareId," <font color=red><---Check licenses</font>") :-
	count_licenses(SoftwareId,UsedNoOfLicenses),
	software_db(SoftwareId,_,LegalNoOfLicenses,_),
	UsedNoOfLicenses>LegalNoOfLicenses,!.
  check_license_problem(_,"").
	

/******************************************************************************
	Accessing and updating the DB
******************************************************************************/
clauses
  % flow (o,o) is Nondeterm
  software(Id,Name):-
	free(Id),free(Name),!,
	findall(E,software_elems(E),L),
	retsorted(L,e(Id,Name)).
  % Other flows are determ
  software(Id,Description):-
	software_db(Id,Description,_,_),!.

  software(SoftwareId,NameOfSoftware,LegalNoOfLicenses,UsedNoOfLicenses):-
	software(SoftwareId,NameOfSoftware,LegalNoOfLicenses,UsedNoOfLicenses,_).

  % flow (o,o,o,o,o) is Nondeterm
  software(SoftwareId,NameOfSoftware,LegalNoOfLicenses,UsedNoOfLicenses,ParmList):-
	free(SoftwareId),!,
	software(SoftwareId,NameOfSoftware), % Return Sorted !
	software_db(SoftwareId,_,LegalNoOfLicenses,ParmList),
	count_licenses(SoftwareId,UsedNoOfLicenses).

  software(SoftwareId,NameOfSoftware,LegalNoOfLicenses,UsedNoOfLicenses,ParmList):-
	software_db(SoftwareId,NameOfSoftware,LegalNoOfLicenses,ParmList),
	!,
	count_licenses(SoftwareId,UsedNoOfLicenses).

  % flow (o,o) is Nondeterm
  user(Id,Name):-
	free(Id),free(Name),!,
	findall(E,user_elems(E),L),
	retsorted(L,e(Id,Name)).
  % Other flows are determ
  user(Id,Name):-
	user_db(Id,Name,_),!.

  user(Id,Name,ParmList):-
	free(Id),!,
	user(Id,Name),
	user_db(Id,_,ParmList).
  user(Id,FullName,ParmList):-
	user_db(Id,FullName,ParmList),!.

  % flow (o,o) and (o,i) is nondeterm
  license(User,Software):-
	free(User),!,
	license_db(User,Software).
  % flow (i,o) is also nondeterm
  license(User,Software):-
	free(Software),!,
	license_db(User,Software).
  % flow (o,o) is determ
  license(User,Software):-
	license_db(User,Software),!.

  software_user(SoftwareId,UserId,UserName):-
	findall(User,software_user_elems(SoftwareId,User),L),
	retsorted(L,e(UserId,UserName)).
	
  user_software(UserId,SoftwareId,SoftwareName,LicenseProblem):-
	findall(Software,user_software_elems(UserId,Software),L),
	retsorted(L,e(SoftwareId,SoftwareName)),
	check_license_problem(SoftwareId,LicenseProblem).

  add_software(Id,_,_,_):-
	software_db(Id,_,_,_),!,
	errorexit(err_memo_used).
  add_software(_,SoftwareName,_,_):-
	software_db(_,SoftwareName,_,_),!,
	errorexit(err_descr_used).
  add_software(_,"",_,_):-
	errorexit(err_emptydescr).
  add_software(Id,SoftwareName,NoOfLicenses,ParmList):-
	assert(software_db(Id,SoftwareName,NoOfLicenses,ParmList)).

  update_software(_,"",_,_):-!,
	errorexit(err_emptydescr).
  update_software(_,_,NoOfLicenses,_):-
	NoOfLicenses<0,
	!,
	errorexit(err_nooflicensesmustbepositive).
  update_software(Id,Name,NoOfLicenses,ParmList):-
	retract(software_db(Id,_,_,_)),!,
	assert(software_db(Id,Name,NoOfLicenses,ParmList)).
  update_software(_,_,_,_):-
	errorexit(err_unknown_memo_in_update).

  remove_software(Id):-
	retractall(license_db(_,Id)),
	retractall(software_db(Id,_,_,_)).

  add_user(Id,_,_):-
	user_db(Id,_,_),!,
	errorexit(err_memo_used).
  add_user(_,UserName,_):-
	user_db(_,UserName,_),!,
	errorexit(err_descr_used).
  add_user(_,"",_):-
	errorexit(err_emptydescr).
  add_user(Id,UserName,ParmList):-
	assert(user_db(Id,UserName,ParmList)).

  update_user(_,"",_):-!,
	errorexit(err_emptydescr).
  update_user(Id,UserName,ParmList):-
	retract(user_db(Id,_,_)),!,
	assert(user_db(Id,UserName,ParmList)).
  update_user(_,_,_):-
	errorexit(err_unknown_memo_in_update).

  remove_user(Id):-
	retractall(user_db(Id,_,_)),
	retractall(license_db(Id,_)).

  add_license(User,_):-
	not(user_db(User,_,_)),!,
	errorexit(err_unknown_user).
  add_license(_,Softw):-
	not(software_db(Softw,_,_,_)),!,
	errorexit(err_unknown_software).
  add_license(User,Softw):-
	license_db(User,Softw),!,	
	errorexit(err_license_alreadyfound).
  add_license(User,Softw):-
	assert(license_db(User,Softw)).

  remove_license(User,Softw):-
	retract(license_db(User,Softw)),
	!.
  remove_license(_,_):-
	errorexit(err_license_notfound).

  getnewid(No1):-
	idcounter(No),
	No1=No+1,
	assert(idcounter(No1)).

/*
Proposal for interfacing to SQL database !

CONSTANTS
  constODBCName="softw"
  constUser="sa"
  constPassWord=""

/*****************************************************************************
	Tools for easy ODBC Handling
*****************************************************************************/

DOMAINS
  ODBCREF = odbcref(HENV,HDBC,HSTMT)
  Record  = ODBC_DATA*
  ODBCTypeList = INTEGER*

PREDICATES
  determ ODBCREF tryInitquery(STRING SQLQuery)
  procedure endquery(ODBCREF)
  determ tryfetchNext(ODBCREF)
  nondeterm fetchrow_nd(ODBCREF,ODBCTypeList,Record)
  procedure getCols(ODBCREF,INTEGER colNo,ODBCTypeList,Record)

CLAUSES
  % Initialize Everything !
  tryinitquery(SQLQuery,odbcref(HENV,HDBC,HSTMT)):-
	odbcinit(),
	odbcAllocEnv(HENV),
	odbcAllocConnect(HENV,HDBC),
	odbcConnect(HENV,HDBC,constODBCName,constUser,constPassWord),
	odbcAllocStmt(HENV,HDBC,HSTMT),
	trap(odbcExecDirect(HENV,HDBC,HSTMT,SQLQuery),_,write(SQLQUERY)),
	tryfetchNext(odbcref(HENV,HDBC,HSTMT)).

  % Close Down Everything !
  endquery(odbcref(HENV,HDBC,HSTMT)):-
	odbcFreeStmt(HENV,HDBC,HSTMT,odbc_drop),
	odbcDisconnect(HENV,HDBC),
	odbcFreeConnect(HENV,HDBC),
	odbcFreeEnv(HENV),
	odbcDestroy().

  % Fetch next record; fail at the end
  tryfetchNext(odbcref(HENV,HDBC,HSTMT)):-
	trap(odbcFetch(HENV,HDBC,HSTMT),_,fail),!.
  tryfetchNext(ODBCREF):-
	endquery(ODBCREF),
	fail.

  % BackTrack all the records
  fetchrow_nd(ODBCREF,TypeList,Record):-
	getCols(ODBCREF,1,TypeList,Record).
  fetchrow_nd(ODBCREF,TypeList,Record):-
	tryfetchNext(ODBCREF),
	fetchrow_nd(ODBCREF,TypeList,Record).

  getCols(_,_,[],[]):-!.
  getCols(odbcref(HENV,HDBC,HSTMT),ColNo,[Type|RestTypes],[ColData|RestData]):-!,
	odbcGetData(HENV,HDBC,HSTMT,ColNo,Type,1024,ColData,_), % 2DO Bad with the Fixed Size !!!!
	ColNo1 = ColNo+1,
	getCols(odbcref(HENV,HDBC,HSTMT),ColNo1,RestTypes,RestData).
  getCols(_,_,_,_):-errorexit.

/*****************************************************************************
	Connecting Predicates with the SQL Tables
*****************************************************************************/

PREDICATES
  nondeterm software(STRING Description)-(o)
  nondeterm users_oo(STRING Id,STRING FullName)-(o,o)
  nondeterm users_io(STRING Id,STRING FullName)-(i,o)
  nondeterm license_io(STRING User,STRING Software)-(i,o)
  nondeterm software_user_io(STRING Software,STRING Id,STRING User)-(i,o,o)

CLAUSES
  software(Description):-
	ODBCREF = tryinitquery("select Description from software order by Description"),
	fetchrow_nd(ODBCREF,[odbc_string],Record),
	Record = [s(Description)].

  users_oo(Id,FullName):-
	ODBCREF = tryinitquery("select Id,FullName from persons order by FullName"),
	fetchrow_nd(ODBCREF,[odbc_string,odbc_string],Record),
	Record = [s(Id),s(FullName)].

  users_io(Id,FullName):-
	format(Query,"select FullName from persons where persons.Id='%' order by FullName",Id),
	ODBCREF = tryinitquery(Query),
	fetchrow_nd(ODBCREF,[odbc_string],Record),
	Record = [s(FullName)].

  license_io(User,Software):-
	format(Query,"select Software,Person from licenser where Person='%' order by Software",User),
	ODBCREF = tryinitquery(Query),
	fetchrow_nd(ODBCREF,[odbc_string],Record),
	Record = [s(Software)].

  software_user_io(Software,Id,User):-
	format(Query,"SELECT Persons.Id, Persons.FullName FROM Licenser INNER JOIN Persons ON Licenser.Person = Persons.Id WHERE Licenser.Software ='%' ORDER BY Persons.FullName",Software),
	ODBCREF = tryinitquery(Query),
	fetchrow_nd(ODBCREF,[odbc_string,odbc_string],Record),
	Record = [s(MEMO),s(User)].
*/