Source for main Program
/*****************************************************************************
Copyright (c) My Company
Project: license
FileName: license.PRO
Purpose: No description
Written by: Visual Prolog
Comments:
******************************************************************************/
include "license.inc"
include "include\\pdcrunt.pre"
include "www\\include\\cgi\\cgitools.pre"
include "database.pre"
include "www\\include\\cgi\\cgitools.pro"
/*****************************************************************************
Generate some common links
*****************************************************************************/
predicates
procedure write_common_links()
clauses
write_common_links():-
write("<P>\n"),
write("<A HREF=\"license.exe\">Users</A>\n"),
write("<A HREF=\"license.exe?action=show_all_software\">Software</A>\n"),
write("</P>\n").
/*****************************************************************************
Lookup PARM in ParmList, Return empty string if not found
*****************************************************************************/
predicates
procedure lookupParm(string ParmName,parmList,string Value)-(i,i,o)
clauses
lookupParm(_,[],"").
lookupParm(ParmName,[parm(ParmName,Value)|_],Value):-!.
lookupParm(ParmName,[_|List],Value):-
lookupParm(ParmName,List,Value).
/*****************************************************************************
Remove empty parameter values
*****************************************************************************/
predicates
procedure remove_empty(parmList,parmList)-(i,o)
clauses
remove_empty([],[]).
remove_empty([parm(_,"")|Rest],Filtered):-!,
remove_empty(Rest,Filtered).
remove_empty([H|Rest],[H|Filtered]):-
remove_empty(Rest,Filtered).
/*****************************************************************************
Handling of list of generic fields for a Form
Passing in a list of Field Specifiers with Parameter names, and a list
of actual prameter values. Write the FORM elements for this.
*****************************************************************************/
domains
fieldSpec = text(integer Size); textarea(integer Rows,integer Cols)
field = field(string FieldName,string Title,fieldSpec)
fieldList = field*
predicates
procedure write_FieldList(fieldList,parmList)-(i,i)
procedure write_Field(string Title,string FieldName,fieldSpec,string Value)-(i,i,i,i)
clauses
write_Field(Title,FieldName,text(Size),Value):-
write("<td>",Title," <td><input type=\"text\" name=\"",FieldName,"\" VALUE=\"",Value,"\" size=\"",Size,"\">\n").
write_Field(Title,FieldName,textarea(Rows,Cols),Value):-
write("<td>",Title," <td><textarea name=\"",FieldName,"\" Rows=\"",Rows,"\" Cols=\"",Cols,"\">",Value,"</textarea>\n").
write_FieldList([],_).
write_FieldList([field(FieldName,Title,FieldSpec)|FieldList],ParmList):-
lookupParm(FieldName,ParmList,Value),
write("<tr>"),
write_Field(Title,FieldName,FieldSpec,Value),
write("</tr>"),
write_FieldList(FieldList,ParmList).
/*****************************************************************************
Generate the inputform for Users/users
*****************************************************************************/
predicates
procedure write_user_form(string Title,string Action,userId,string UserName,parmList)
procedure write_user_form_id(userId)
clauses
write_user_form(Title,Action,UserId,UserName,ParmList):-
FieldList = [
field("Type","Computer Type:",text(40)),
field("Speed","Computer Speed:",text(40)),
field("Ram","MB Ram:",text(40)),
field("Disk","MB Disk:",text(40)),
field("ScreenCard","Screen Card:",text(40)),
field("NetCard","Net Card:",text(40)),
field("SoundCard","Sound Card:",text(40)),
field("Comments","Comments:",textarea(4,32))],
write("<form method=\"POST\" action=\"license.exe\"\n"),
write("<p><b>",Title,"</b></p>\n"),
write("<input TYPE=\"hidden\" name=\"action\" VALUE=\"",Action,"\">\n"),
write_user_form_id(UserId), % For the updating, the ID is needed !
write("<table>\n"),
write("<tr><td>Name: <td><input type=\"text\" name=\"name\" VALUE=\"",UserName,"\" size=\"40\"></tr>\n"),
write_FieldList(FieldList,ParmList),
write("</table>\n"),
write("<p>\n<input type=\"submit\" VALUE=\"Submit\">\n"),
write("<input type=\"reset\" VALUE=\"Reset\">\n"),
write("</p>\n</form>\n").
write_user_form_id(0):-!.
write_user_form_id(UserId):-
write("<input TYPE=\"hidden\" NAME=\"id\" VALUE=\"",UserId,"\">\n").
/*****************************************************************************
Generate the inputform for Software
*****************************************************************************/
predicates
procedure write_software_form(string Title,string Action,softwareId,string SoftwareName,integer LegalNoOfLicenses,integer UsedNoOfLicenses,parmList)
procedure write_software_form_id(softwareId)
clauses
write_software_form(Title,Action,SoftwareId,SoftwareName,LegalNoOfLicenses,UsedNoOfLicenses,ParmList):-
FieldList = [
field("Version","Version:",text(40)),
field("OS","Platform:",text(40)),
field("SerNo","Serial No.:",text(40)),
field("Date","Date:",text(40)),
field("Developer","Developer",textarea(4,32)),
field("Supplier","Supplier:",text(40)),
field("Medium","Medium:",text(40)),
field("Comments","Comments:",textarea(4,32))],
write("<form method=\"POST\" action=\"license.exe\"\n"),
write("<p><b>",Title,"</b></p>\n"),
write("<input TYPE=\"hidden\" name=\"action\" VALUE=\"",Action,"\">\n"),
write_software_form_id(SoftwareId),
write("<table>\n"),
write("<tr><td>Name: <td><input type=\"text\" name=\"name\" VALUE=\"",SoftwareName,"\" size=\"40\"></tr>\n"),
write("<tr><td>Number of Licenses: <td><input type=\"text\" name=\"nooflicenses\" VALUE=\"",LegalNoOfLicenses,"\" size=\"3\">\n"),
write(" (Used Licenses: ",UsedNoOfLicenses,")</tr>\n"),
write_FieldList(FieldList,ParmList),
write("</table>\n"),
write("<p>\n<input type=\"submit\" VALUE=\"Submit\">\n"),
write("<input type=\"reset\" VALUE=\"Reset\">\n"),
write("</p>\n</form>\n").
write_software_form_id(0):-!.
write_software_form_id(SoftwareId):-
write("<input TYPE=\"hidden\" NAME=\"id\" VALUE=\"",SoftwareId,"\">\n").
/*****************************************************************************
Writing the collumnlist for a table, based on the generic values
*****************************************************************************/
domains
colList = string*
predicates
procedure write_ColList(colList,parmList)-(i,i)
lookupParmBR(string ParmName,parmList,string Value)-(i,i,o)
clauses
write_ColList([],_).
write_ColList([ParmName|Rest],ParmList):-
lookupParmBR(ParmName,ParmList,Value),
write("<td align=right>"),
write(Value),
write_ColList(Rest,ParmList).
% Return <br> instead of empty string if parm not found
lookupParmBR(ParmName,ParmList,Value):-
lookupParm(ParmName,ParmList,Value),
Value><"",!.
lookupParmBR(_,_,"<BR>").
/*****************************************************************************
Command: Show Page with list of ALL users
*****************************************************************************/
predicates
procedure show_all_users()
procedure write_user_table(colList)
clauses
show_all_users():-
write("<head></head>\n"),
write("<body>\n"),
write("<H1>Workstations & Servers</H1>\n\n"),
write("<HR>\n"),
write("<p><table border=1>\n"),
write("<TR><TD>Name <TD>Computer Type<TD>Speed(Mhz)<TD>Ram(MB)<TD>Disk(GB)</tr>\n"),
ColList = ["Type","Speed","Ram","Disk"],
write_user_table(ColList),
write("</table></p>\n"),
write("<table bgcolor=yellow border=1><tr><td>\n"),
write_user_form("Add User or Server","add_new_user",0,"",[]),
write("</td></tr></table>\n"),
write_common_links(),
write("</body>\n").
write_user_table(ColList):-
user(UserId,FullName,ParmList),
write("<TR><TD><A HREF=\"license.exe?action=show_user&user=",
UserId,"\">",FullName,"</A>"),
write_ColList(ColList,ParmList),
write("</TR>\n"),
fail.
write_user_table(_).
/*****************************************************************************
Command: Show Page for given User
*****************************************************************************/
predicates
procedure show_user(userId)
procedure show_softwareforusertable(userId)
procedure write_adduseoflicense_form(userId)
procedure write_addsoftw_options(userId)
procedure cond_write_heading(userId)
clauses
show_user(UserId):-
write("<head></head>\n"),
write("<body>\n"),
user(UserId,UserName,ParmList),!,
write("<H1>",UserName,"</H1>\n"),
write("<HR>\n"),
write("<P>\n"),
cond_write_heading(UserId), % Write only heading if some software are registered
show_softwareforusertable(UserId),
write("</P>\n"),
write("<p><table bgcolor=gray border=1>\n"),
write("<tr><td><A HREF=\"license.exe?action=delete_user&user=",UserId,"\">Delete ",UserName,"</A></tr>\n"),
write("</table></p>\n"),
write("\n<table bgcolor=yellow border=1>\n<tr><td>\n\n"),
write_adduseoflicense_form(UserId),
write("\n<td>\n\n"),
write_user_form("Update Information","renameuser",UserId,UserName,ParmList),
write("</table>\n\n"),
write_common_links(),
write("</body>\n").
show_user(UserId):-
write("<H1>Unknown userid ",UserId,"</H1>\n"),
write("</body>\n").
show_softwareforusertable(UserId):-
user_software(UserId,SoftwareId,SoftwareName,LicenseProblem),
write("<A HREF=\"license.exe?action=delete_userforsoftware&user=",
UserId,"&software=",SoftwareId,"\">Del</A>--> \n"),
write("<A HREF=\"license.exe?action=show_software&software=",
SoftwareId,"\">",SoftwareName,"</A>",LicenseProblem),
write("<BR>\n"),
fail.
show_softwareforusertable(_).
write_adduseoflicense_form(UserId):-
write("<form method=\"POST\" action=\"license.exe\"\n"),
write("<p><b>Add new licenses</b><br>\n"),
write("(Multiple selection is possible)</p>\n"),
write("<input TYPE=\"hidden\" name=\"action\" VALUE=\"add_software_to_user\">\n"),
write("<input TYPE=\"hidden\" NAME=\"name\" VALUE=\"",UserId,"\">\n"),
write("<p><select name=\"LIST\" size=\"16\" multiple>\n"),
write_addsoftw_options(UserId),
write("</select></p>\n"),
write("<p>\n<input type=\"submit\" VALUE=\"Register\" name=\"B1\">\n"),
write("<input type=\"reset\" VALUE=\"Reset\" name=\"B2\">\n</p>\n"),
write("</form>\n").
write_addsoftw_options(UserId):-
software(SoftwareId,SoftwareDescription),
not(license(UserId,SoftwareId)),
write("<option VALUE=\"",SoftwareId,"\">",SoftwareDescription,"</option>\n"),
fail.
write_addsoftw_options(_).
cond_write_heading(UserId):-
license(UserId,_),!, % write heading if at least one software registered !
write("<b>Licenses already registered:</b><BR>\n").
cond_write_heading(_).
/*****************************************************************************
Command: Show Page for a given Software
*****************************************************************************/
predicates
procedure show_software(softwareId)
procedure show_usersforsoftwaretable(softwareId)
procedure write_adduseoflicense_software_form(softwareId)
procedure write_addusers_options(softwareId)
clauses
show_software(SoftwareId):-
write("<head></head>\n"),
write("<body>\n"),
software(SoftwareId,SoftwareName,LegalNoOfLicenses,UsedNoOfLicenses,ParmList),!,
write("<H1>",SoftwareName,"</H1>\n"),
write("<HR>\n"),
write("<P><b>",UsedNoOfLicenses," Users:</b><br>\n"),
show_usersforsoftwaretable(SoftwareId),
write("</P>\n"),
write("<p><table bgcolor=gray border=1>\n"),
write("<tr><td><A HREF=\"license.exe?action=delete_software&software=",SoftwareId,"\">Delete ",SoftwareName,"</A></tr>\n"),
write("</table></p>\n"),
write("\n<table bgcolor=yellow border=1>\n<tr><td>\n\n"),
write_adduseoflicense_software_form(SoftwareId),
write("\n<td>\n\n"),
write_software_form("Update","updatesoftware",SoftwareId,SoftwareName,LegalNoOfLicenses,UsedNoOfLicenses,ParmList),
write("</table>\n\n"),
write_common_links(),
write("</body>\n").
show_software(_):-
errorexit(). % Software ID Not found !
show_usersforsoftwaretable(SoftwareId):-
software_user(SoftwareId,UserId,FullName),
write("<A HREF=\"license.exe?action=delete_softwareforuser&user=",
UserId,"&software=",SoftwareId,"\">Del</A>--> "),
write("<A HREF=\"license.exe?action=show_user&user=",
UserId,"\">",FullName,"</A><BR>\n"),
fail.
show_usersforsoftwaretable(_).
write_adduseoflicense_software_form(SoftwareId):-
write("<form method=\"POST\" action=\"license.exe\"\n"),
write("<p><b>Register new users</b><br>\n"),
write("(Multiple selection is possible)</p>\n"),
write("<input TYPE=\"hidden\" name=\"action\" VALUE=\"add_user_to_software\">\n"),
write("<input TYPE=\"hidden\" NAME=\"name\" VALUE=\"",SoftwareId,"\">\n"),
write("<p><select name=\"LIST\" size=\"20\" multiple>\n"),
write_addusers_options(SoftwareId),
write("</select></p>\n"),
write("<p>\n<input type=\"submit\" VALUE=\"Register\" name=\"B1\">\n"),
write("<input type=\"reset\" VALUE=\"Reset\" name=\"B2\">\n</p>\n"),
write("</form>\n").
write_addusers_options(SoftwareId):-
user(UserId,UserName),
not(license(UserId,SoftwareId)),
write("<option VALUE=\"",UserId,"\">",UserName,"</option>\n"),
fail.
write_addusers_options(_).
/*****************************************************************************
Command: Show page with all software
*****************************************************************************/
predicates
procedure show_all_software()
procedure show_licensestable()
procedure conditional_coloredtd(integer,integer)
clauses
show_all_software():-
write("<head></head>\n"),
write("<body>\n"),
write("<H1>Software</H1>\n"),
write("<HR>\n"),
show_licensestable,
write("<p><b>Add New Software</b></p>\n"),
write("<table border=1 bgcolor=\"#FFFF00\"><tr><td>"),
write_software_form("","add_new_software",0,"",0,0,[]),
write("</td></tr></table>"),
write_common_links(),
write("</body>\n").
show_licensestable():-
write("</p><table border=1>\n"),
write("<tr><th>Software<th>Actual Licenses<th>Used Licenses<tr>\n"),
software(SoftwareId,NameOfSoftware,LegalNoOfLicenses,UsedNoOfLicenses),
write("<tr>"),
conditional_coloredtd(LegalNoOfLicenses,UsedNoOfLicenses),
write("<A HREF=\"license.exe?action=show_software&software=",
SoftwareId,"\">",NameOfSoftware,"</A><BR>\n"),
conditional_coloredtd(LegalNoOfLicenses,UsedNoOfLicenses),
write(LegalNoOfLicenses),
conditional_coloredtd(LegalNoOfLicenses,UsedNoOfLicenses),
write(UsedNoOfLicenses),
write("</tr>\n"),
fail.
show_licensestable():-
write("</table></p>\n").
conditional_coloredtd(ActualNoOfLicenses,UsedNoOfLicenses):-
ActualNoOfLicenses>=UsedNoOfLicenses,!,
write("<td>").
conditional_coloredtd(_,_):-
write("<td bgcolor=\"#FF0000\">").
/*****************************************************************************
Command: Add new User
*****************************************************************************/
predicates
procedure add_new_user(string Name,parmList)
clauses
add_new_user(Name,ParmList):-
ID = getnewid(),
remove_empty(ParmList,Filtered),
add_user(Id,Name,Filtered),
show_all_users().
/*****************************************************************************
Command: Delete User - has been confirmed
*****************************************************************************/
predicates
procedure confirmed_delete_user(userId)
clauses
confirmed_delete_user(User):-
remove_user(User),
show_all_users().
/*****************************************************************************
Command: Request to delete user
*****************************************************************************/
predicates
procedure delete_user(userId)
clauses
delete_user(UserId):-
write("<head></head>\n"),
write("<body>\n"),
user(UserId,UserName),!,
write("<H1>Are you Sure ?</H1>\n"),
write("<hr>\n"),
write("<p><A HREF=\"license.exe?action=confirmed_delete_user&user=",UserId,"\">Yes, Please Delete ",UserName,"</A></p>\n"),
write("<p><A HREF=\"license.exe\">UPS That was a mistake</A></p>\n"),
write("</body>\n").
delete_user(_):-
errorexit(). % UserID Not Found
/*****************************************************************************
Command: Add new licenses for a user
*****************************************************************************/
predicates
procedure add_software_to_user(userId,parmList)
clauses
add_software_to_user(UserId,[parm("B1",_)|_]):-!,
show_user(UserId).
add_software_to_user(UserId,[parm("LIST",X)|LIST]):-
str_int(X,SoftwareId),!,
add_license(UserId,SoftwareId),
add_software_to_user(UserId,LIST).
add_software_to_user(_,_):-
errorexit(). % SoftwareID NOT Found !
/*****************************************************************************
Command: Delete a license for a User - from the User's page
*****************************************************************************/
predicates
procedure delete_userforsoftware(userId,softwareId)
clauses
delete_userforsoftware(UserId,Software):-
remove_license(UserId,Software),
show_user(UserId).
/*****************************************************************************
Command: Rename user
*****************************************************************************/
predicates
procedure renameuser(userId,string Name,parmList)
clauses
renameuser(UserId,UserName,ParmList):-
remove_empty(ParmList,Filtered),
update_user(UserId,UserName,Filtered),
show_user(UserId).
/*****************************************************************************
Command: Add new user for a given software
*****************************************************************************/
predicates
procedure add_user_to_software(softwareId,parmlist)
clauses
add_user_to_software(Software,[parm("B1",_)|_]):-!,
show_software(Software).
add_user_to_software(Software,[parm("LIST",User)|LIST]):-
str_int(User,UserId),!,
add_license(UserId,Software),
add_user_to_software(Software,LIST).
add_user_to_software(_,_):-
errorexit().
/*****************************************************************************
Command: Delete a software for a user
*****************************************************************************/
predicates
procedure delete_softwareforuser(userId,softwareId)
clauses
delete_softwareforuser(User,Software):-
remove_license(User,Software),
show_software(Software).
/*****************************************************************************
Command: Rename software
*****************************************************************************/
predicates
procedure updatesoftware(softwareId,string Name,integer NoOfLicenses,parmList)
clauses
updatesoftware(SoftwareId,SoftwareName,NoOfLicenses,ParmList):-
remove_empty(ParmList,Filtered),
update_software(SoftwareId,SoftwareName,NoOfLicenses,Filtered),
show_software(SoftwareId).
/*****************************************************************************
Command: Add new software
*****************************************************************************/
predicates
procedure add_new_software(string Name,integer NoOfLicenses,parmList)
clauses
add_new_software(Name,NoOfLicenses,ParmList):-
Id = getnewid(),
remove_empty(ParmList,Filtered),
add_software(Id,Name,NoOfLicenses,Filtered),
show_all_software().
/*****************************************************************************
Command: Delete a software - has been confirmed
*****************************************************************************/
predicates
procedure confirmed_delete_software(softwareId)
clauses
confirmed_delete_software(SoftwareId):-
remove_software(SoftwareId),
show_all_software().
/*****************************************************************************
Command: Request to delete software
*****************************************************************************/
predicates
procedure delete_software(softwareId)
clauses
delete_software(SoftwareId):-
write("<head></head>\n"),
write("<body>\n"),
software(SoftwareId,SoftwareName),!,
write("<H1>Are you Sure ?</H1>\n"),
write("<hr>\n"),
write("<p><A HREF=\"license.exe?action=confirmed_delete_software&software=",SoftwareId,"\">Yes, Please Delete ",SoftwareName,"</A></p>\n"),
write("<p><A HREF=\"license.exe?action=show_all_software\">UPS That was a mistake</A></p>\n"),
write("</body>\n").
delete_software(_):-
errorexit(). %Software ID NOT found !
/*****************************************************************************
Select Action !
Based on the first parameter value in the ParmList, Select which action to
perform !
*****************************************************************************/
predicates
procedure select_action(parmlist)-(i)
procedure convNoOfLicenses(string,integer)-(i,o) % Returns 0 if string invalid
clauses
select_action([]):-!,
show_all_users().
select_action([parm("action","show_all_users")]):-!,
show_all_users().
select_action([parm("action","show_all_software")]):-!,
show_all_software().
select_action([parm("action","show_user"),parm("user",User)]):-
str_int(User,UserId),!,
show_user(UserId).
select_action([parm("action","show_software"),parm("software",Software)]):-
str_int(Software,SoftwareId),!,
show_software(SoftwareId).
select_action([parm("action","add_new_software"),parm("name",Name),parm("nooflicenses",SNo)|ParmList]):-
convNoOfLicenses(SNo,NoOfLicenses),!,
add_new_software(Name,NoOfLicenses,ParmList),
db_save().
select_action([parm("action","add_new_user"),parm("name",Name)|ParmList]):-!,
add_new_user(Name,ParmList),
db_save().
select_action([parm("action","add_user_to_software"),parm("name",Software)|List]):-
str_int(Software,SoftwareId),!,
add_user_to_software(SoftwareId,List),
db_save().
select_action([parm("action","add_software_to_user"),parm("name",User)|List]):-
str_int(User,UserID),!,
add_software_to_user(UserId,List),
db_save().
select_action([parm("action","renameuser"),parm("id",User),parm("name",Name)|ParmList]):-
str_int(User,UserID),!,
renameuser(UserID,Name,ParmList),
db_save().
select_action([parm("action","updatesoftware"),parm("id",Software),parm("name",Name),parm("nooflicenses",SNo)|ParmList]):-
str_int(Software,SoftwareId),
convNoOfLicenses(SNo,NoOfLicenses),!,
updatesoftware(SoftwareId,Name,NoOfLicenses,ParmList),
db_save().
select_action([parm("action","delete_softwareforuser"),parm("user",User),parm("software",Software)]):-
str_int(User,UserID),str_int(Software,SoftwareId),!,
delete_softwareforuser(UserID,SoftwareId),
db_save().
select_action([parm("action","delete_userforsoftware"),parm("user",User),parm("software",Software)]):-
str_int(User,UserID),str_int(Software,SoftwareId),!,
delete_userforsoftware(UserId,SoftwareId),
db_save().
select_action([parm("action","confirmed_delete_software"),parm("software",Software)]):-
str_int(Software,SoftwareId),!,
confirmed_delete_software(SoftwareId),
db_save().
select_action([parm("action","delete_software"),parm("software",Software)]):-
str_int(Software,SoftwareId),!,
delete_software(SoftwareId),
db_save().
select_action([parm("action","delete_user"),parm("user",User)]):-
str_int(User,UserID),!,
delete_user(UserID),
db_save().
select_action([parm("action","confirmed_delete_user"),parm("user",User)]):-
str_int(User,UserID),!,
confirmed_delete_user(UserID),
db_save().
select_action(List):-
write("Unknown input argument for licenseViewer\n"),
write(List),nl,
errorexit().
convNoOfLicenses(SNo,NoOfLicenses):-
trap(str_int(SNo,NoOfLicenses),_,fail),!.
convNoOfLicenses(_,0).
/*****************************************************************************
Main Goal
*****************************************************************************/
goal
write("Content-type: text/html\n\n"),
write("<html>\n"),
db_load("c:\\licenses\\dd.dba"),
ParmList = cgi_GetParmList(),
% write("<PRE>Command: ",ParmList,"<PRE>\n"),
select_action(ParmList),
write("</html>\n").