# File: caudmsg.cpl
#
# $Id: caudmsgscript.htm,v 1.1 2001/01/05 17:27:01 ibi Exp $ (c) 1999-2000 Carapace Communications Ltd
#
# Audit object extension: Message
#
# Classes:
#
# MsgAuditor - record messages in the audit
# MsgAudit - filter messages in the audit
# MsgAdmin - administer the messaging audit
#
#
# Attributes: sender, recipient, subject, length, msg type, msg id, relation
# -- we allow many recipients
(if (! (isClass (quote Db))) (load "adodb.cpl"))
(class MsgAuditor
(interface
(properties
(db Db)
(headings HashTable)
)
(methods
(NIL MsgAuditor ( (db Db) ) )
(NIL record ( (id String) (msg Object) ) )
)
)
)
(class MsgAudit
(interface
(properties
(db Db)
# maps attribute --> (alias columnName)
(attributes HashTable)
)
(methods
(NIL MsgAudit ( (db Db) ) )
(List filterHeadings ())
(List displayHeadings ())
(Object fetch ( (id String) ) )
# test if the object exists
(Object exists ( (id String) ) )
(List relationships () )
# return the HTML template used to define the messaging filter
(String filterPage () )
# return the HTML template used to display the object
# the template can be instantiated by args class=xxx&id=yyy
(String detailsPage () )
)
)
)
(class MsgAdmin
(interface
(properties
(db Db)
)
(methods
(NIL MsgAdmin ( (db Db) ) )
# delete the object
(NIL delete ( (id String) ) )
# delete all objects created before the supplied time
(NIL purge ( (toTime String) ) )
)
)
)
#
## MsgAuditor: methods
#
(defun NIL MsgAuditor::MsgAuditor ( (db Db) )
(this.db db)
(this.headings (create HashTable))
(this.headings.set "sender" "sender")
(this.headings.set "subject" "subject")
(this.headings.set "length" "msgSize")
(this.headings.set "msg type" "msgType")
(this.headings.set "msg id" "msgId")
)
(defun NIL MsgAuditor::record ( (id String) (msg Object) )
(local (recips List)
(relations List)
(pair List)
(names List)
(values List)
(marks List)
(attrib String)
(name String)
(value Object)
(stmt String)
(db Db)
(err Error)
)
(set db (this.db))
(for pair msg
(set attrib (headOf pair))
(set value (headOf (tailOf pair)))
(cond
( (== attrib "recipient")
(set recips (cons value recips))
)
# for non-null values:
( value
(set name (this.headings.get attrib))
(if (! name)
(throw (create Error 1 1 "unknown message attribute '" attrib "'"))
)
(set names (cons name names))
(set values (cons value values))
(set marks (cons "?" marks))
)
)
)
(if (! names)
(throw (create Error 1 1 "no message audit data to insert"))
)
(set names (cons "objId" names))
(set values (cons id values))
(set marks (cons "?" marks))
(set stmt ("insert into caudMsg (creationTime, ".+
(join names ", ")
") values ("
(db.insertionTime)
", "
(join marks ", ")
")"
)
)
# now insert the records
(db.beginTransaction)
(try
(do
(db.sqlAux stmt values)
(for name recips
(db.sqlAux "insert into caudMsgRecip(objId, recipient) values (?, ?)"
(list id name)
)
)
(for pair relations
(db.sqlAux "insert into caudMsgReln(objIdLeft, relation, objIdRight) values (?, ?, ?)"
pair
)
)
(db.commit)
)
(catch -1
(db.rollback)
(throw err)
)
)
)
#
## MsgAudit: methods
#
(defun NIL MsgAudit::MsgAudit ( (db Db) )
(this.db db)
(this.attributes (create HashTable))
(this.attributes.set "sender" (list "cm" "sender"))
(this.attributes.set "subject" (list "cm" "subject"))
(this.attributes.set "length" (list "cm" "msgSize"))
(this.attributes.set "msg type" (list "cm" "msgType"))
(this.attributes.set "msg id" (list "cm" "msgId"))
(this.attributes.set "recipient" (list "cmr" "recipient"))
)
(defun List MsgAudit::filterHeadings ()
(return (list "sender"
"recipient"
"subject"
"msg id"
"msg type"
)
)
)
(defun List MsgAudit::displayHeadings ()
(return (quote (("sender" ())
("recipient" ())
("subject" ())
("msg id" ())
("msg type" ())
("length" ())
)
)
)
)
(defun List MsgAudit::relationships ()
(return (list "contains"
"is-report-for"
"is-notification-for"
)
)
)
(defun Object MsgAudit::fetch ( (id String) )
(local (db Db)
(rows List)
(row List)
(value Object)
(msg List)
)
(set db (this.db))
# fetch the main row
(set rows (db.sqlAux "select msgType, sender, subject, msgSize, msgId from caudMsg where objId = ?"
(list id)
)
)
(if (! rows)
(throw (create Error 1 1 "no such message with id " id))
)
(set row (headOf rows))
(set value (headOf row))
(set row (tailOf row))
(if value (set msg (cons (list "msg type" value) msg)))
(set value (headOf row))
(set row (tailOf row))
(if value (set msg (cons (list "sender" value) msg)))
(set value (headOf row))
(set row (tailOf row))
(if value (set msg (cons (list "subject" value) msg)))
(set value (headOf row))
(set row (tailOf row))
(if value (set msg (cons (list "length" value) msg)))
(set value (headOf row))
(set row (tailOf row))
(if value (set msg (cons (list "msg id" value) msg)))
# fetch any recipients
(for row (db.sqlAux "select recipient from caudMsgRecip where objId = ?"
(list id)
)
(set msg (cons (list "recipient" (headOf row)) msg))
)
(return msg)
)
# test if the object exists
(defun Object MsgAudit::exists ( (id String) )
(local (rows List)
)
(set rows (this.db.sqlAux "select objId from caudMsg where objId = ?"
(list id)
)
)
(return (if rows 1 ()))
)
# return the HTML template used to define the messaging filter
(defun String MsgAudit::filterPage ()
(return "auditMsgFilter.htm")
)
# return the HTML template used to display the object
# the template can be instantiated by args class=xxx&id=yyy
#
(defun String MsgAudit::detailsPage ()
(return "auditMsg.htm")
)
#
## MsgAdmin: methods
#
(defun NIL MsgAdmin::MsgAdmin ( (db Db) )
(this.db db)
)
# delete the object
(defun NIL MsgAdmin::delete ( (id String) )
(local (db Db)
(err Error)
)
(set db this.db)
(db.beginTransaction)
(try
(do
(db.sqlAux "delete from caudMsgRecip where objId = ?"
(list id)
)
(db.sqlAux "delete from caudMsg where objId = ?"
(list id)
)
)
(catch -1
(db.rollback)
(throw err)
)
)
(db.commit)
)
# delete all objects created before the supplied time
(defun NIL MsgAdmin::purge ( (toTime String) )
(local (objId String)
(row List)
)
(for row (this.db.sql ("select objId from caudMsg where creationTime < '".+
toTime
"' order by creationTime asc"
)
)
(this.delete row.head)
)
)
|
