aspTemplate : 类似 phpLib::Template 的分离层实现(续)

这次加入了数据库模板功能 :)

'#######################################################################

'## NAME: aspTemplate

'## BY: BigHan

'## DATE: Nov. 28, 2003

'## SITE: http://aspTemplate.yeah.net/

'## EMAIL: aspTemplate@21cn.com

'##

'#######################################################################

'## Database Table: See db/aspTemplate.mdb

'#######################################################################

Class aspTemplate

'####

'## name of this class

'## var string

'## @access Private

'## @see property: Name

'####

Private m_strName

'####

'## version of this class

'## var string

'## @access Private

'## @see property: Version

'####

Private m_strVersion

'####

'## Determines how much debugging output Template will produce.

'## This is a bitwise mask of available debug levels:

'## 0 = no debugging

'## 1 = debug variable assignments

'## 2 = debug calls to get variable

'## 3 = debug SQL

'## 4 = debug internals (outputs all function calls with parameters).

'##

'## @var int

'## @access Private

'## @see property: Debug

'####

Private m_intDebug

'####

'## Template files data type

'##

'## "db" = Database

'## "file" = File

'##

'## @var string

'## @access private

'## @see property: Mode

'####

Private m_strMode

'####

'## The base directory from which template files are loaded.

'##

'## @var string

'## @access private

'## @see property: Root, Dir; method: SetRoot, set_root

'####

Private m_Root

'####

'## Determines how to output variable tags with no assigned value in templates.

'##

'## @var string

'## @access private

'## @see property Unknowns; method: SetUnknowns, set_unknowns

'####

Private m_strUnknowns

'####

'## Determines how Template handles error conditions.

'## "yes" = the error is reported, then execution is halted

'## "report" = the error is reported, then execution continues by returning "false"

'## "no" = errors are silently ignored, and execution resumes reporting "false"

'##

'## @var string

'## @access private

'## @see property IsHalt; method: halt

'####

Private m_strHaltError

'####

'## The last error message is retained in this variable.

'##

'## @var string

'## @access private

'## @see property LastError

'##

Private m_strLastError

'####

'## Opening delimiter (usually "{")

'##

'## @var string

'## @access private

'## @see property BeginTag

'####

Private m_strBeginTag

'####

'## Closing delimiter (usually "}")

'##

'## @var string

'## @access private

'## @see private EndTag

'####

Private m_strEndTag

'####

'## A hash of strings forming a translation table which translates variable names

'## into names of files containing the variable content.

'## m_oFile.Item(varname) = "filename";

'##

'## @var object

'## @access private

'## @see method: SetFile, SetFiles, set_file

'####

Private m_oFile

'####

'## Regular Expression Object

'##

'## @var object

'## @access private

'####

Private m_oRegExp

'####

'## A hash of strings forming a translation table which translates variable names

'## into regular expressions for themselves.

'## m_oVarKeys.Item(varname) = "{varname}"

'##

'## @var object

'## @access private

'## @see method: SetVar, SetVars, SetAppendVar, SetAppendVars, set_var

'####

Private m_oVarKeys

'####

'## A hash of strings forming a translation table which translates variable names

'## into values for their respective varkeys.

'## m_oVarVals.Item(varname) = "value"

'##

'## @var object

'## @access private

'## @see method: SetVar, SetVars, SetAppendVar, SetAppendVars, set_var

'####

Private m_oVarVals

'####

'## Connection Object, if this Mode = "db" the Connection Object need.

'##

'## @var object

'## @access private

'## @see property: ActiveConnection, method: OpenTemplateDatabase, CloseTemplateDatabase

'####

Private m_oConn

'####

'## Is native connection object.

'##

'## @var object

'## @access private

'## @see property: ActiveConnection, method: OpenTemplateDatabase, CloseTemplateDatabase

'####

Private m_blnNativeConnection

'####

'## Is Open connection object.

'##

'## @var object

'## @access private

'## @see property: ActiveConnection, method: OpenTemplateDatabase, CloseTemplateDatabase

'####

Private m_blnConnectionState

'####

'## Template database set table name.

'##

'## @var string

'## @access private

'## @see property: CatTable

'####

Private m_strCatTable

'####

'## Template database data table name.

'##

'## @var string

'## @access private

'## @see property: DataTable

'####

Private m_strDataTable

'####

'## get class name attribute.

'##

'## usage: oTemplate.Name

'## access public

'##

Public Property Get Name()

'############################################################

Name = m_strName

End Property

'####

'## get class version property.

'##

'## usage: oTemplate.Version

'## access public

'##

Public Property Get Version()

'############################################################

Version = m_strVersion

End Property

'####

'## get/set m_strMode property.

'##

'## usage: oTemplate.Mode = string A_strType

'## access public

'##

Public Property Let Mode(ByVal A_strType)

'############################################################

If Debug = 4 Then Response.Write "Mode: A_strType = " & A_strType & "" & VbCrLf

A_strType = LCase(A_strType)

Select Case A_strType

Case "file"

m_strMode = "file"

Case "db"

m_strMode = "db"

End Select

End Property

Public Property Get Mode()

Mode = m_strMode

End Property

'####

'## set m_oConn property.

'##

'## usage: oTemplate.ActiveConnection = object A_oConn

'## access public

'##

Public Property Let ActiveConnection(ByRef A_oConn)

'############################################################

If Debug = 3 Then Response.Write "ActiveConnection: Use ActiveConnection" & VbCrLf

if IsObject(A_oConn) Then

If A_oConn.State <> AdStateClosed Then

Set m_oConn = A_oConn

m_blnConnectionState = True

m_blnNativeConnection = False

End If

End Property

'####

'## set/get m_strCatTable property.

'##

'## usage: oTemplate.CatTable = string A_strCatTable

'## access public

'##

Public Property Let CatTable(ByVal A_strCatTable)

'############################################################

If Debug = 3 Then Response.Write "CatTable: A_strCatTable = " & A_strCatTable & "" & VbCrLf

m_strCatTable = A_strCatTable

End Property

Public Property Get CatTable()

CatTable = m_strCatTable

End Property

'####

'## set/get m_strDataTable property.

'##

'## usage: oTemplate.DataTable = string A_strDataTable

'## access public

'##

Public Property Let DataTable(ByVal A_strDataTable)

'############################################################

If Debug = 3 Then Response.Write "DataTable: A_strDataTable = " & A_strDataTable & "" & VbCrLf

m_strDataTable = A_strDataTable

End Property

Public Property Get DataTable()

DataTable = m_strDataTable

End Property

'####

'## get/set m_intDebug attribute.

'##

'## usage: oTemplate.Debug = int A_intDebug

'## access public

'##

Public Property Let Debug(ByVal A_intDebug)

'############################################################

m_intDebug = CInt(A_intDebug)

End Property

Public Property Get Debug()

Debug = m_intDebug

End Property

'####

'## Sets the policy for dealing with unresolved variable names.

'##

'## unknowns defines what to do with undefined template variables

'## "remove" = remove undefined variables

'## "comment" = replace undefined variables with comments

'## "keep" = keep undefined variables

'##

'## Note: "comment" can cause unexpected results when the variable tag is embedded

'## inside an HTML tag, for example a tag which is expected to be replaced with a URL.

'##

'## usage: oTemplate.Unknowns = string A_strUnknowns

'##

'## @param A_strUnknowns new value for unknowns

'## @see unknowns, SetUnknowns, set_unknowns

'## @access public

'##

Public Property Let Unknowns(ByVal A_strUnknowns)

'############################################################

If Debug = 4 Then Response.Write "Unknowns: unknowns = " & A_strUnknowns & "" & VbCrLf

A_strUnknowns = LCase(A_strUnknowns)

Select Case A_strUnknowns

Case "keep"

m_strUnknowns = "keep"

Case "remove"

m_strUnknowns = "remove"

Case "comment"

m_strUnknowns = "comment"

Case Else

m_strUnknowns = "remove"

End Select

End Property

Public Property Get Unknowns()

Unknowns = m_strUnknowns

End Property

'####

'## Checks that root is a valid directory and if so sets this directory as the

'## base directory from which templates are loaded by storing the value in

'## Root. Relative filenames are prepended with the path in Root.

'##

'## usage: oTemplate.Root = string A_strDir

'##

'## @param A_root string containing new template directory

'## @see m_Root, SetRoot, set_root

'## @access public

'##

Public Property Let Root(ByVal A_strDir)

'############################################################

Dim MM_FSO, sql, rs, MM_TempDir, num

If Debug = 4 Then Response.Write "Root: root = " & A_strDir & "" & VbCrLf

If Len(A_strDir) > 0 Then

If Mode = "file" Then

Set MM_FSO = CreateObject("Scripting.FileSystemObject")

If MM_FSO.FolderExists(Server.MapPath(A_strDir)) Then

If Right(A_strDir, 1) <> "/" Then

m_Root = A_strDir & "/"

Else

m_Root = A_strDir

End If

Else

Call halt("The folder " & A_strDir & " does not exist.")

End If

ElseIf Mode = "db" Then

If Right(A_strDir, 1) = "/" Then A_strDir = left(A_strDir, len(A_strDir) -1)

If left(A_strDir, 1) = "/" Then A_strDir = Right(A_strDir, len(A_strDir) -1)

MM_TempDir = Split(A_strDir, "/")

num = UBound(MM_TempDir)

If num > 0 Then A_strDir = MM_TempDir(num)

sql = "SELECT tplcat_id FROM " & CatTable & " WHERE tplcat_name='" & A_strDir &"'"

Set rs = Server.CreateObject("ADODB.Recordset")

rs.Open sql, m_oConn, AdOpenForwardOnly, AdLockReadOnly, adCmdText

If Not rs.EOF Then

m_Root = rs("tplcat_id")

Else

Call halt("Not Find template category " & A_strDir & " from database.")

End If

Set rs = Nothing

If Debug = 3 Then Response.Write "Root: sql = " & sql & "" & VbCrLf

End If

Else

Call halt("The folder Root does not empty.")

End If

End Property

Public Property Get Root()

Root = m_Root

End Property

'####

'##

'## alias of Root

'##

Public Property Let Dir(ByVal A_strDir)

'############################################################

Root = A_strDir

End Property

Public Property Get Dir()

Dir = Root

End Property

'####

'## Set/Get class m_strHaltError attribute.

'##

'## "yes" = the error is reported, then execution is halted.

'## "no" = errors are silently ignored.

'## "report" = the error is reported, then execution continues.

'##

'## usage: oTemplate.IsHalt = string A_strHalt

'##

'## @param A_strHalt new value for m_strHaltError

'## @see Halt

'## @access public

'##

Public Property Let IsHalt(ByVal A_strHalt)

'############################################################

A_strHalt = LCase(A_strHalt)

Select Case A_strHalt

Case "yes"

m_strHaltError = "yes"

Case "no"

m_strHaltError = "no"

Case "report"

m_strHaltError = "report"

End Select

End Property

Public Property Get IsHalt()

IsHalt = m_strHaltError

End Property

'####

'## Set/Get class m_strBeginTag attribute.

'##

'## Note: Don't conflict of HTML tag

'##

'## usage: oTemplate.BeginTag = string A_strTag

'##

'## @param A_strTag new value for m_strBeginTag

'## @access public

'##

Public Property Let BeginTag(ByVal A_strTag)

'############################################################

If Debug = 4 Then Response.Write "BeginTag: BeginTag = " & A_strTag & "" & VbCrLf

m_strBeginTag = A_strTag

End Property

Public Property Get BeginTag()

BeginTag = m_strBeginTag

End Property

'####

'## Set/Get class m_strEndTag attribute.

'##

'## Note: Don't conflict of HTML tag

'##

'## usage: oTemplate.EndTag = string A_strTag

'##

'## @param A_strTag new value for m_strEndTag

'## @access public

'##

Public Property Let EndTag(ByVal A_strTag)

'############################################################

If Debug = 4 Then Response.Write "EndTag: EndTag = " & A_strTag & "" & VbCrLf

m_strEndTag = A_strTag

End Property

Public Property Get EndTag()

EndTag = m_strEndTag

End Property

'####

'## Get class last error messages.

'##

'## usage: oTemplate.LastError

'##

'## @access public

'##

Public Property Get LastError()

'############################################################

LastError = m_strLastError

End Property

'####

'## Open template database Connection object. if this Mode="db", need first open.

'##

'## usage: oTemplate.OpenTemplateDatabase string A_strConnString

'##

'## @access public

'##

Public Sub OpenTemplateDatabase(ByVal A_strConnString)

'############################################################

on error resume next

If Debug = 3 Then Response.Write "OpenTemplateDatabase: A_strConnString = " & A_strConnString & "" & VbCrLf

if IsNull(m_oConn) Or Not IsObject(m_oConn) Then

Set m_oConn = Server.CreateObject("ADODB.Connection")

m_oConn.ConnectionString = A_strConnString

m_oConn.Open

If Err Then

err.Clear

Set m_oConn = Nothing

Call halt("Connection: Open Connection by string " & A_strConnString & " error.")

Else

m_blnConnectionState = True

m_blnNativeConnection = True

End If

End Sub

'####

'## Close template database Connection object.

'##

'## usage: oTemplate.CloseTemplateDatabase

'##

'## @access public

'##

Public Sub CloseTemplateDatabase()

'############################################################

if IsObject(m_oConn) Then

If Debug = 3 Then Response.Write "CloseTemplateDatabase: Close Database ... ..." & VbCrLf

If m_blnNativeConnection = True Then

m_oConn.Close

Set m_oConn = Nothing

Else

Set m_oConn = Nothing

End If

m_blnConnectionState = False

End Sub

'####

'##

'## @see Root

'##

Public Sub SetRoot(ByVal A_strDir)

'############################################################

Root = A_strDir

End Sub

'## @same phplib::template->set_root

Public Sub set_root(ByVal A_strDir)

Root = A_strDir

End Sub

'####

'##

'## @see Unknown

'##

Public Sub SetUnknowns(ByVal A_strUnknowns)

'############################################################

Unknowns = A_strUnknowns

End Sub

'## @same phplib::template->set_root

Public Sub set_unknowns(ByVal A_strUnknowns)

Unknowns = A_strUnknowns

End Sub

'####

'## Defines a filename for the initial value of a variable.

'##

'## It may be passed either a varname and a file name as two strings or

'## a hash of strings with the key being the varname and the value

'## being the file name.

'##

'## The new mappings are stored in the object m_oFile.

'## The files are not loaded yet, but only when needed.

'##

'## usage: oTemplate.SetFile A_varname, A_filename

'## or

'## usage: oTemplate.SetFile array(A_varname1, A_filename1 _

'## ,A_varname2, A_filename2 _

'## ,.... .... , ,,,. ,,,, ) _

'## , ""

'## @see SetFiles

'## @param A_varname either a string containing a varname or a hash of varname/file name pairs.

'## @param A_filename if varname is a string this is the filename otherwise filename is not required

'## @access public

'##

Public Sub SetFile(ByVal A_varname, ByVal A_filename)

'############################################################

Dim MM_strFiles, num

If Not IsArray(A_varname) Then

If Debug = 4 Then Response.Write "SetFile: (with scalar) varname = "& A_varname &", filename = "& A_filename &"" & VbCrLf

If A_filename = "" Then

Call halt("SetFile: For varname " & A_filename & " filename is empty.")

Exit Sub

End If

MM_strFiles = filename(A_filename)

m_oFile.Add A_varname, MM_strFiles

Else

Call SetFiles(A_varname)

End If

End Sub

'####

'## Defines a multi-filename for the initial value of a variable.

'##

'## usage: oTemplate.SetFiles array(A_varname1, A_filename1 _

'## ,A_varname2, A_filename2 _

'## ,.... .... , ,,,. ,,,, )

'## @param array A_varname

'## @access public

'## @see SetFile

'##

Public Sub SetFiles(ByVal A_varname)

'############################################################

Dim i, num

If IsArray(A_varname) Then

num = Ubound(A_varname)

if ((num +1) mod 2) <> 0 Then

Call halt("SetFiles: For varname array's element not gemination.")

Exit Sub

Else

For i = 0 To num Step 2

Call SetFile(A_varname(i), A_varname(i+1))

End If

Else

Call SetFile(A_varname, "")

End If

End Sub

'## @same phplib::template->set_file

Public Sub set_file(ByVal A_varname, ByVal A_filename)

Call SetFile(A_varname, A_filename)

End Sub

'####

'## A variable $parent may contain a variable block defined by:

'##  content . This function removes

'## that block from $parent and replaces it with a variable reference named $name.

'## The block is inserted into the varkeys and varvals hashes. If A_name is

'## omitted, it is assumed to be the same as A_varname.

'##

'## Blocks may be nested but care must be taken to extract the blocks in order

'## from the innermost block to the outermost block.

'##

'## usage: oTemplate.SetBlock string A_parent, string A_parent, string A_name

'##

'## @param A_parent a string containing the name of the parent variable

'## @param A_varname a string containing the name of the block to be extracted

'## @param A_name the name of the variable in which to store the block

'## @access public

'##

Public Sub SetBlock(ByVal A_parent, ByVal A_varname, ByVal A_name)

'############################################################

Dim MM_String, MM_MatchString

If Debug = 4 Then Response.Write "SetBlock: parent = " & A_parent & ", varname = " & A_varname & ", name = " & A_name & "" & VbCrLf

If Not loadfile(A_parent) Then

Call halt("SetBlock: unable to load " & A_parent & ".")

Exit Sub

End If

if A_name = "" Then A_name = A_varname

MM_String = GetVar(A_parent)

m_oRegExp.IgnoreCase = True

m_oRegExp.Global = True

m_oRegExp.Pattern = "([\s\S.]*)"

Set Matches = m_oRegExp.Execute(MM_String)

For Each Match In Matches

MM_MatchString = Match.SubMatches(1)

MM_String = m_oRegExp.Replace(MM_String, BeginTag & A_name & EndTag)

Call SetVar(A_varname,MM_MatchString)

Call SetVar(A_parent,MM_String)

End Sub

'## @same phplib::template->set_block

Public Sub set_block(ByVal A_parent, ByVal A_varname, ByVal A_name)

Call SetBlock(A_parent, A_varname, A_name)

End Sub

'####

'## This functions sets the value of a variable.

'##

'## It may be called with either a varname and a value as two strings or an

'## an associative array with the key being the varname and the value being

'## the new variable value.

'##

'## The function inserts the new value of the variable into the $varkeys and

'## $varvals hashes. It is not necessary for a variable to exist in these hashes

'## before calling this function.

'##

'## usage: oTemplate.SetVar string A_varname, string A_value

'## or

'## usage: oTemplate.SetVar array( A_varname1, A_value1 _

'## ,A_varname2, A_value2 _

'## , ... , ... ) _

'## , ""

'##

'## @param A_varname either a string containing a varname or a hash of varname/value pairs.

'## @param A_value if A_varname is a string this contains the new value for the variable otherwise this parameter is ignored

'## @access public

'##

Public Sub SetVar(ByVal A_varname, ByVal A_value)

'############################################################

Dim MM_varname

If Not IsArray(A_varname) Then

If A_varname <> "" Then

If Debug = 1 Then Response.Write "SetVar: (with scalar) " & A_varname & " = " & Server.HTMLEncode(A_value) & " " & VbCrLf

MM_varname = varname(A_varname)

if m_oVarKeys.Exists(A_varname) Then

m_oVarKeys.Remove A_varname

m_oVarKeys.Add A_varname, MM_varname

Else

m_oVarKeys.Add A_varname, MM_varname

End If

If m_oVarVals.Exists(A_varname) Then

m_oVarVals.Remove A_varname

m_oVarVals.Add A_varname, A_value

Else

m_oVarVals.Add A_varname, A_value

End If

Else

Call SetVars(A_varname)

End If

End Sub

'####

'## usage: oTemplate.SetVar array( A_varname1, A_value1 _

'## ,A_varname2, A_value2 _

'## , ... , ... )

'## @param A_varname a hash of varname/value pairs.

'## @access public

'## @see SetVar

'##

Public Sub SetVars(ByVal A_varname)

'############################################################

Dim i, num

If IsArray(A_varname) Then

num = Ubound(A_varname)

if ((num +1) mod 2) <> 0 Then

Call halt("SetVars: For varname array's element not gemination.")

Exit Sub

Else

For i = 0 To num Step 2

Call SetVar(A_varname(i), A_varname(i+1))

End If

Else

Call SetVar(A_varname, "")

End If

End Sub

'####

'## usage: oTemplate.SetAppendVar string A_varname, string A_value

'## or

'## usage: oTemplate.SetAppendVar array( A_varname1, A_value1 _

'## ,A_varname2, A_value2 _

'## , ... , ... ) _

'## , ""

'## @param A_varname either a string containing a varname or a hash of varname/value pairs.

'## @param A_value if A_varname is a string this contains the new value for the variable otherwise this parameter is ignored

'## @access public

'## @see SetVar

'##

Public Sub SetAppendVar(ByVal A_varname, ByVal A_value)

'############################################################

Dim MM_varname, MM_string

If Not IsArray(A_varname) Then

If A_varname <> "" Then

If Debug = 1 Then Response.Write "SetAppendVar: (with scalar) " & A_varname & " = " & Server.HTMLEncode(A_value) & " " & VbCrLf

MM_varname = varname(A_varname)

if m_oVarKeys.Exists(A_varname) Then

m_oVarKeys.Remove A_varname

m_oVarKeys.Add A_varname, MM_varname

Else

m_oVarKeys.Add A_varname, MM_varname

End If

If m_oVarVals.Exists(A_varname) Then

MM_string = m_oVarVals.Item(A_varname) & A_value

m_oVarVals.Remove A_varname

m_oVarVals.Add A_varname, MM_string

Else

m_oVarVals.Add A_varname, A_value

End If

Else

Call SetAppendVars(A_varname)

End If

End Sub

'####

'## usage: oTemplate.SetAppendVars array( A_varname1, A_value1 _

'## ,A_varname2, A_value2 _

'## , ... , ... )

'## @param A_varname a hash of varname/value pairs.

'## @access public

'## @see SetVar

'##

Public Sub SetAppendVars(ByVal A_varname)

'############################################################

Dim i, num

If IsArray(A_varname) Then

num = Ubound(A_varname)

if ((num +1) mod 2) <> 0 Then

Call halt("SetVars: For varname array's element not gemination.")

Exit Sub

Else

For i = 0 To num Step 2

Call SetAppendVar(A_varname(i), A_varname(i+1))

End If

Else

Call SetAppendVar(A_varname, "")

End If

End Sub

'####

'##

'## @same phplib::template->set_var

'##

Public Sub set_var(ByVal A_varname, ByVal A_value, ByVal A_append)

'############################################################

If CBool(A_append) = True Then

If Not IsArray(A_varname) Then

Call SetAppendVar(A_varname, A_value)

Else

Call SetAppendVars(A_varname, A_value)

End If

Else

If Not IsArray(A_varname) Then

Call SetVar(A_varname, A_value)

Else

Call SetVars(A_varname, A_value)

End If

End Sub

'####

'## This function fills in all the variables contained within the variable named

'## A_varname. The resulting value is returned as the function result and the

'## original value of the variable varname is not changed. The resulting string

'## is not "finished", that is, the unresolved variable name policy has not been

'## applied yet.

'##

'## Returns: the value of the variable $varname with all variables substituted.

'##

'## usage: SubString(string A_varname)

'##

'## @param A_varname the name of the variable within which variables are to be substituted

'## @access public

'## @return string

'##

Public Function SubString(ByVal A_varname)

'############################################################

Dim MM_String

If Debug = 4 Then Response.Write "SubString: varname = " & A_varname & "" & VbCrLf

If Not loadfile(A_varname) Then

Call halt("SubString: unable to load " & A_varname & ".")

End If

MM_String = GetVar(A_varname)

m_oRegExp.IgnoreCase = True

m_oRegExp.Global = True

m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag

Set Matches = m_oRegExp.Execute(MM_String)

For Each Match In Matches

if m_oVarVals.Exists(Match.SubMatches(1)) Then

m_oRegExp.Pattern = Match.Value

MM_String = m_oRegExp.Replace(MM_String, m_oVarVals.Item(Match.SubMatches(1)))

End If

SubString = MM_String

End Function

'####

'##

'## @same phplib::template->subst

'##

Public Function subst(ByVal A_varname)

subst = SubString(A_varname)

End Function

'####

'## This is shorthand for print SubString(A_varname). See SubString for further

'## details.

'##

'## usage: oTemplate.WriteSubString string A_varname

'##

'## @param A_varname the name of the variable within which variables are to be substituted

'## @access public

'## @see SubString

'##

Public Sub WriteSubString(ByVal A_varname)

'############################################################

If Debug = 4 Then Response.Write "WriteSubString: varname = " & A_varname & "" & VbCrLf

Response.Write SubString(A_varname)

End Sub

'####

'##

'## @same phplib::template->psubst

'##

Public Sub psubst(ByVal A_varname)

Call WriteSubString(A_varname)

End Sub

'####

'## The function substitutes the values of all defined variables in the variable

'## named A_varname and stores or appends the result in the variable named A_target.

'##

'## It may be called with either a target and a varname as two strings or a

'## target as a string and an array of variable names in varname.

'##

'## The function inserts the new value of the variable into the oVarVeys and

'## $varvals hashes. It is not necessary for a variable to exist in these hashes

'## before calling this function.

'##

'## An optional third parameter allows the value for each varname to be appended

'## to the existing target variable instead of replacing it. The default is to

'## replace.

'##

'## If A_target and A_varname are both strings, the substituted value of the

'## variable A_varname is inserted into or appended to A_target.

'##

'## Returns: the last value assigned to A_target.

'##

'## usage: oTemplate.Parse string A_target, string A_varname, boolean A_append

'## usage: string = oTemplate.Parse( string A_target, string A_varname, boolean A_append )

'## or

'## usage: oTemplate.Parse string A_target, array(A_varname1, A_varname2, ...) , boolean A_append

'## usage: string = oTemplate.Parse( string A_target, array(A_varname1, A_varname2, ...), boolean A_append)

'##

'## @param A_target a string containing the name of the variable into which substituted $varnames are to be stored

'## @param A_varname if a string, the name the name of the variable to substitute or if an array a list of variables to be substituted

'## @param A_append if true, the substituted variables are appended to $target otherwise the existing value of $target is replaced

'## @access public

'## @return string

'## @see SubString

'##

'## @same phplib::template->pparse

'##

Public Function Parse(ByVal A_target, ByVal A_varname, ByVal A_append)

'############################################################

Dim MM_String, i, num

If Not IsArray(A_varname) Then

If Debug = 4 Then Response.Write "Parse: (with scalar) target = " & A_target & ", varname = " & A_varname & ", append = " & A_append & "" & VbCrLf

MM_String = SubString(A_varname)

if A_append = True Then

MM_String = GetVar(A_target) & MM_String

Call SetVar(A_target, MM_String)

Else

Call SetVar(A_target, MM_String)

End If

Else

num = Ubound(A_varname)

For i = 0 To num

If Debug = 4 Then Response.Write "Parse: (with array) target = " & A_target & ", varname = " & A_varname(i) & ", append = " & A_append & "" & VbCrLf

MM_String = SubString(A_varname(i))

if A_append = True Then

MM_String = GetVar(A_target) & MM_String

Call SetVar(A_target, MM_String)

Else

Call SetVar(A_target, MM_String)

End If

If Debug = 4 Then Response.Write "Parse: completed" & VbCrLf

Parse = MM_String

End Function

'####

'## This is shorthand for print Parse(...) and is functionally identical.

'## See Parse for further details.

'##

'## Returns: always returns void.

'##

'## usage: oTemplate.Write string A_target, string A_varname

'##

'## @param A_target a string containing the name of the variable into which substituted $varnames are to be stored

'## @param A_varname if a string, the name the name of the variable to substitute or if an array a list of variables to be substituted

'## @access public

'## @return void

'## @see Parse

'##

Public Sub Write(ByVal A_target, ByVal A_varname)

'############################################################

Dim MM_string

If Debug = 4 Then Response.Write "Write: passing parameters to parse..." & VbCrLf

MM_string = Parse(A_target, A_varname, False)

MM_string = Finish(MM_string)

Response.Write MM_string

End Sub

'####

'##

'## @see Write

'##

Public Sub AppendWrite(ByVal A_target, ByVal A_varname)

'############################################################

Dim MM_string

If Debug = 4 Then Response.Write "Write: passing parameters to parse..." & VbCrLf

MM_string = Parse(A_target, A_varname, True)

MM_string = Finish(MM_string)

Response.Write MM_string

End Sub

'####

'##

'## @same phplib::template->pparse

'##

Public Sub pparse(ByVal A_target, ByVal A_varname, ByVal A_append)

'############################################################

If CBool(A_append) = True Then

Call AppendWrite(A_target, A_varname)

Else

Call Write(A_target, A_varname)

End If

End Sub

'####

'## This function returns an associative object of all defined variables with the

'## name as the key and the value of the variable as the value.

'##

'## This is mostly useful for debugging. Also note that $this->debug can be used

'## to echo all variable assignments as they occur and to trace execution.

'##

'## Returns: a hash of all defined variable values keyed by their names.

'##

'## usage: oTemplate.get_vars()

'##

'## @access public

'## @return object

'##

Public Function GetVars()

'############################################################

If Debug = 4 Then Response.Write "GetVars: constructing dictionary of vars..." & VbCrLf

Set GetVars = m_oVarVals

End Function

'####

'##

'## @same phplib::template->get_vars

'##

Public Function get_vars()

Set get_vars = GetVars()

End Function

'####

'## This function returns the value of the variable named by A_varname.

'## If A_varname references a file and that file has not been loaded yet, the

'## variable will be reported as empty.

'##

'## When called with an array of variable names this function will return a a

'## hash of variable values keyed by their names.

'##

'## Returns: a string or an array containing the value of $varname.

'##

'## usage: GetVar(string A_varname)

'## or

'## usage: GetVar(array A_varname)

'##

'## @param A_varname if a string, the name the name of the variable to get the value of, or if an array a list of variables to return the value of

'## @access public

'## @return string or object

'##

Public Function GetVar(ByVal A_varname)

'############################################################

Dim MM_String, MM_oVars, i, num

If Not IsArray(A_varname) Then

'MM_String = ""

if A_varname <> "" Then

If m_oVarVals.Exists(A_varname) Then

MM_String = m_oVarVals.Item(A_varname)

End If

If Debug = 2 Then Response.Write "GetVar: (with scalar) " & A_varname & " = " & Server.HTMLEncode(MM_String) & " " & VbCrLf

GetVar = MM_String

Else

Set MM_oVars = CreateObject("Scripting.Dictionary")

num = UBound(A_varname)

For i=0 To num

If m_oVarVals.Exists(A_varname(i)) Then

MM_String = m_oVarVals.Item(A_varname(i))

MM_oVars.Add A_varname(i), MM_String

End If

If Debug = 2 Then Response.Write "GetVar: (with array) " & A_varname(i) & " = " & Server.HTMLEncode(MM_String) & " " & VbCrLf

Set GetVar = MM_oVars

End If

End Function

'####

'##

'## @same phplib::template->get_var

'##

Public Function get_var(ByVal A_varname)

If Not IsArray(A_varname) Then

get_var = GetVar(A_varname)

Else

Set get_var = GetVar(A_varname)

End If

End Function

'####

'## This functions clears the value of a variable.

'##

'## It may be called with either a varname as a string or an array with the

'## values being the varnames to be cleared.

'##

'## The function sets the value of the variable in the oVarKeys and oVarVals

'## hashes to "". It is not necessary for a variable to exist in these hashes

'## before calling this function.

'##

'## usage: oTemplate.ClearVar string A_varname

'## or

'## usage: oTemplate.ClearVar array (A_varname1, A_varname2, ...)

'##

'## @param $varname either a string containing a varname or an array of varnames.

'## @access public

'## @return void

'##

Public Sub ClearVar(ByVal A_varname)

'############################################################

Dim i, num

If Not IsArray(A_varname) Then

If A_varname <> "" Then

If Debug = 1 Then Response.Write "clear_var: (with scalar) " & A_varname & " " & VbCrLf

Call SetVar(A_varname, "")

End If

Else

num = UBound(A_varname)

For i=0 To num

If Debug = 1 Then Response.Write "clear_var: (with array) " & A_varname(i) & " " & VbCrLf

Call SetVar(A_varname(i), "")

End If

End Sub

'####

'##

'## @same phplib::template->clear_var

'##

Public Sub clear_var(ByVal A_varname)

Call ClearVar(A_varname)

End Sub

'####

'## This functions unsets a variable completely.

'##

'## It may be called with either a varname as a string or an array with the

'## values being the varnames to be cleared.

'##

'## The function removes the variable from the oVarKeys and oVarVals hashes.

'## It is not necessary for a variable to exist in these hashes before calling

'## this function.

'##

'## usage: oTemplate.unSetVar string A_varname

'## or

'## usage: oTemplate.unSetVar array(A_varname1, A_varname2, ...)

'##

'## @param A_varname either a string containing a varname or an array of varnames.

'## @access public

'##

Public Sub unSetVar(ByVal A_varname)

'############################################################

Dim i, num

If Not IsArray(A_varname) Then

If A_varname <> "" Then

If Debug = 1 Then Response.Write "unSetVar: (with scalar) " & A_varname & " " & VbCrLf

If m_oVarKeys.Exists(A_varname) Then

m_oVarKeys.Remove A_varname

End If

If m_oVarVals.Exists(A_varname) Then

m_oVarVals.Remove A_varname

End If

Else

num = UBound(A_varname)

For i=0 To num

If A_varname(i) <> "" Then

If Debug = 1 Then Response.Write "unSetVar: (with array) " & A_varname & " " & VbCrLf

If m_oVarKeys.Exists(A_varname(i)) Then

m_oVarKeys.Remove A_varname(i)

End If

If m_oVarVals.Exists(A_varname(i)) Then

m_oVarVals.Remove A_varname(i)

End If

End Sub

'####

'##

'## @same phplib::template->unset_var

'##

Public Sub unset_var(ByVal A_varname)

Call unSetVar(A_varname)

End Sub

'####

'## This function returns a hash of unresolved variable names in A_varname, keyed

'## by their names.

'##

'## Returns: a hash of varname/varname pairs or false on error.

'##

'## usage: GetUndefined(string A_varname)

'##

'## @param A_varname a string containing the name the name of the variable to scan for unresolved variables

'## @access public

'## @return array

'##

Public Function GetUndefined(ByVal A_varname)

'############################################################

Dim MM_String, MM_result

If Debug = 4 Then Response.Write "GetUndefined: varname = " & A_varname & "" & VbCrLf

If Not loadfile(A_varname) Then

Call halt("get_undefined: unable to load " & A_varname & ".")

GetUndefined = False

Exit Function

End If

MM_String = GetVar(A_varname)

'Set MM_result = CreateObject("Scripting.Dictionary")

m_oRegExp.IgnoreCase = True

m_oRegExp.Global = True

m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag

Set Matches = m_oRegExp.Execute(MM_String)

i = 0

For Each Match In Matches

if Not m_oVarVals.Exists(Match.SubMatches(1)) Then

If Debug = 4 Then Response.Write "get_undefined: undefined: " & SubMatches(1) & "" & VbCrLf

'MM_result.Add Match.SubMatches(1), Match.SubMatches(1)

MM_result(i) = Match.SubMatches(1)

i = i + 1

End If

'if MM_result.Count > 0 Then

' Set GetUndefined = MM_result

If IsArray(MM_result) Then

GetUndefined = MM_result

Else

GetUndefined = False

End If

End Function

'####

'##

'## @same phplib::template->get_undefined

'##

Public Function get_undefined(ByVal A_varname)

'############################################################

get_undefined = GetUndefined

End Function

'####

'## This function returns the finished version of $str. That is, the policy

'## regarding unresolved variable names will be applied to $str.

'##

'## Returns: a finished string derived from A_String and unknowns.

'##

'## usage: Finish(string A_String)

'##

'## @param A_String a string to which to apply the unresolved variable policy

'## @access public

'## @return string

'## @see Unknowns, SetUnknowns, set_unknowns

'##

Public Function Finish(ByVal A_String)

'############################################################

Dim MM_String

Select Case Unknowns

case "keep"

MM_String = A_String

case "remove"

m_oRegExp.IgnoreCase = True

m_oRegExp.Global = True

m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag

MM_String = m_oRegExp.Replace(A_String, "")

case "comment"

m_oRegExp.IgnoreCase = True

m_oRegExp.Global = True

m_oRegExp.Pattern = "(" & BeginTag & ")([^ \t\r\n" & EndTag &"]+)" & EndTag

Set Matches = m_oRegExp.Execute(A_String)

For Each Match In Matches

MM_String = m_oRegExp.Replace(A_String, "")

End Select

Finish = MM_String

End Function

'####

'## This function returns the finished version of the value of the variable named

'## by $varname. That is, the policy regarding unresolved variable names will be

'## applied to the variable A_varname and the result returned.

'##

'## Returns: a finished string derived from the variable A_varname.

'##

'## usage: oTemplate.GetVariable(string A_varname)

'##

'## @param A_varname a string containing the name of the variable to finish

'## @access public

'## @return string

'## @see SetUnknowns

'## @see Finish

'##

Public Function GetVariable(ByVal A_varname)

'############################################################

GetVariable = Finish(GetVar(A_varname))

End Function

'Public Function get(ByVal A_varname)

'冲突不支持

'End Function

'####

'## This function prints the finished version of the value of the variable named

'## by $varname. That is, the policy regarding unresolved variable names will be

'## applied to the variable A_varname then it will be printed.

'##

'## usage: oTemplate.WriteVariable string A_varname

'##

'## @param A_varname a string containing the name of the variable to finish and print

'## @access public

'## @see SetUnknowns

'## @see Finish

'##

Public Sub WriteVariable(ByVal A_varname)

'############################################################

Response.Write Finish(GetVal(A_varname))

End Sub

'####

'##

'## @see WriteVariable

'## @same phplib::template->p

'##

Public Sub p(ByVal A_varname)

Call WriteVariable(A_varname)

End Sub

'####

'## When called with a relative pathname, this function will return the pathname

'## with Root prepended. Absolute pathnames are returned unchanged.

'##

'## Returns: a string containing an absolute pathname.

'##

'## usage: filename(string A_filename)

'##

'## @param A_filename a string containing a filename

'## @access private

'## @return string

'## @see Root, SetRoot

'##

'## @same phplib::template->filename

'##

Private Function filename(ByVal A_filename)

'############################################################

Dim MM_FSO, MM_filename, MM_TempFilename, rs, sql

If Debug = 4 Then Response.Write "filename: filename = " & A_filename & "" & VbCrLf

If Mode = "file" Then

Set MM_FSO = CreateObject("Scripting.FileSystemObject")

If Left(A_filename, 1) = "/" Then

A_filename = Right(A_filename, len(A_filename) - 1)

End If

A_filename = Root & A_filename

A_filename = Server.MapPath(A_filename)

If Not MM_FSO.FileExists(A_filename) Then

Call halt("filename: file " & A_filename & " does not exist.")

Else

MM_filename = A_filename

End If

ElseIf Mode = "db" Then

A_filename = Split(A_filename, ".")

MM_TempFilename = A_filename(0)

sql = "SELECT tpldata_id FROM " & DataTable & " WHERE tplcat_id =" & Root &" AND tpldata_name='" & MM_TempFilename &"'"

Set rs = Server.CreateObject("ADODB.Recordset")

rs.Open sql, m_oConn, AdOpenForwardOnly, AdLockReadOnly, adCmdText

If rs.EOF Then

Call halt("filename: file " & MM_TempFilename & " does not exist.")

Else

MM_filename = rs("tpldata_id")

End If

Set rs = Nothing

If Debug = 3 Then Response.Write "filename: sql = " & sql & "" & VbCrLf

End If

filename = MM_filename

End Function

'####

'## If a variable's value is undefined and the variable has a filename stored in

'## ofile.Item(A_varname) then the backing file will be loaded and the file's

'## contents will be assigned as the variable's value.

'##

'## Note that the behaviour of this function changed slightly after the 7.2d

'## release. Where previously a variable was reloaded from file if the value

'## was empty, now this is not done. This allows a variable to be loaded then

'## set to "", and also prevents attempts to load empty variables. Files are

'## now only loaded if oVarVals.Item(A_varname) is unset.

'##

'## Returns: true on success, false on error.

'##

'## usage: loadfile(string A_varname)

'##

'## @param A_varname a string containing the name of a variable to load

'## @access private

'## @return boolean

'## @see SetFile, SetFiles

'##

'## @same phplib::template->loadfile

'##

Private Function loadfile(ByVal A_varname)

'############################################################

Dim MM_FSO, MM_oFile, MM_filename, MM_FileSting, MM_bool

If Debug = 4 Then Response.Write "loadfile: varname = " & A_varname & "" & VbCrLf

MM_bool = true

If Not m_oFile.Exists(A_varname) Then

loadfile = MM_bool

If Debug = 4 Then Response.Write "loadfile: varname " & A_varname & " does not reference a file" & VbCrLf

Exit Function

End If

If m_oVarVals.Exists(A_varname) Then

loadfile = MM_bool

If Debug = 4 Then Response.Write "loadfile: varname " & A_varname & " is already loaded" & VbCrLf

Exit Function

End If

MM_filename = m_oFile.Item(A_varname)

If Mode = "file" Then

Set MM_FSO = CreateObject("Scripting.FileSystemObject")

Set MM_oFile = MM_FSO.OpenTextFile(MM_filename)

MM_FileSting = MM_oFile.ReadAll

'MM_FileSting = Trim(MM_FileSting)

If MM_FileSting = "" Then

MM_bool = false

Call halt("loadfile: While loading " & A_varname & ", " & MM_filename & " does not exist or is empty.")

Else

If Debug = 4 Then Response.Write "loadfile: loaded " & MM_filename & " into " & A_varname & " " & VbCrLf

Call SetVar(A_varname, MM_FileSting)

End If

MM_oFile.Close

Set MM_oFile = Nothing

set FSO = nothing

ElseIf Mode = "db" Then

sql = "SELECT tpldata_text FROM " & DataTable & " WHERE tpldata_id =" & MM_filename

Set rs = Server.CreateObject("ADODB.Recordset")

rs.Open sql, m_oConn, AdOpenForwardOnly, AdLockReadOnly, adCmdText

If rs.EOF Then

MM_bool = false

Call halt("filename: file " & MM_TempFilename & " does not exist.")

Else

MM_FileSting = rs("tpldata_text")

Call SetVar(A_varname, MM_FileSting)

End If

Set rs = Nothing

If Debug = 3 Then Response.Write "loadfile: sql = " & sql & "" & VbCrLf

End If

loadfile = MM_bool

End Function

'####

'## This function will construct a regexp for a given variable name with any

'## special chars quoted.

'##

'## Returns: a string containing an escaped variable name.

'##

'## usage: varname(string A_varname)

'##

'## @param A_varname a string containing a variable name

'## @access private

'## @return string

'## @same phplib::template->varname

'##

Private Function varname(ByVal A_varname)

'############################################################

varname = BeginTag & A_varname & EndTag

End Function

'####

'## This function is called whenever an error occurs and will handle the error

'## according to the policy defined in IsHalt. Additionally the

'## error message will be saved in m_strLastError.

'##

'## Returns: always returns false.

'##

'## usage: halt(string A_message)

'##

'## @param $msg a string containing an error message

'## @access private

'## @return void

'## @see IsHalt

'##

Private Sub halt(ByVal A_message)

'############################################################

m_strLastError = A_message

If IsHalt <> "no" Then Call haltmsg(A_message)

If IsHalt = "yes" Then

Response.Write "Halted."

Response.End

End If

End Sub

'####

'## This function prints an error message.

'## It can be overridden by your subclass of Template. It will be called with an

'## error message to display.

'##

'## usage: haltmsg(string A_message)

'##

'## @param A_message a string containing the error message to display

'## @access public

'## @return void

'## @see halt

'##

Public Sub haltmsg(ByVal A_message)

'############################################################

Response.Write "Template Error:" & A_message & " "

End Sub

'####

'## Class constructor, set class default attributes, you can change it

'## @see Property Let Debug

'## @see Property Let Mode

'## @see Property Let CatTable

'## @see Property Let DataTable

'## @see Property Let Unknown

'## @see Property Let IsHalt

'## @see Property Let BeginTag

'## @see Property Let EndTag

'####

Private Sub class_Initialize

Debug = 0

Mode = "file"

CatTable = "TplCat"

DataTable = "TplData"

Unknowns = "remove"

IsHalt = "yes"

m_strLastError = ""

BeginTag = "{"

EndTag = "}"

m_Root = "templates/"

Set m_oFile = CreateObject("Scripting.Dictionary")

Set m_oVarKeys = CreateObject("Scripting.Dictionary")

Set m_oVarVals = CreateObject("Scripting.Dictionary")

Set m_oRegExp = New RegExp

m_blnConnectionState = False

m_strName = "aspTemplate"

m_strVersion = "2.0.0"

If Debug = 4 Then Response.Write "Template: root = " & m_Root & ", unknowns = " & Unknowns & "" & VbCrLf

End Sub

'####

'## Class destructor, free memory.

'####

Private Sub class_Terminate

Set m_oFile = Nothing

Set m_oVarKeys = Nothing

Set m_oVarVals = Nothing

Set m_oRegExp = Nothing

Call CloseTemplateDatabase()

End Sub

End Class