<% '======================================================================================================================= ' IO Helpers '======================================================================================================================= Sub put(v) Select Case typename(v) Case "LinkedList_Class" : response.write join(v.TO_Array, ", ") Case "DynamicArray_Class" : response.write JoinList(v) Case "Variant()" : response.write join(v, ", ") Case else : response.write v End Select End Sub Sub put_ put "
" End Sub Sub putl(v) put v put_ End Sub 'accepts anything that can have an iterator, including lists, arrays, and recordsets Sub putlist(col, prefix, suffix) dim it : set it = IteratorFor(col) Do While it.HasNext put prefix & it.GetNext & suffix Loop End Sub 'same as join() for arrays, but for any arbitrary collection Function JoinList(col) dim s : s = "" dim it : set it = IteratorFor(col) Do While it.HasNext s = s & ", " Loop JoinList = Left(s, Len(s) - 2) End Function '--------------------------------------------------------------------------------------------------------------------- 'Wrapper for Server.HTMLEncode() -- makes it easier on the eyes when reading the HTML code Function H(s) If Not IsEmpty(s) and Not IsNull(s) then H = Server.HTMLEncode(s) Else H = "" End If End Function '----------------------------------------------------------------------------------------------------------------------- 'allows tracing of output on demand without interfering with layout Sub trace(s) comment s End Sub '----------------------------------------------------------------------------------------------------------------------- 'outputs an HTML comment, useful for tracing etc Sub Comment(text) response.write vbcrlf & vbcrlf & "" & vbcrlf & vbcrlf End Sub '----------------------------------------------------------------------------------------------------------------------- 'pseudo-design-by-contract capability, allows strong-typing of methods and views Sub ExpectType(obj_type, obj) if typename(obj) <> obj_type then Err.Raise 1, "lib.Helpers:ExpectType", "View expected object of type '" & obj_type & "' but received type '" & typename(obj) & "'." End Sub '======================================================================================================================= ' Dump* functions for dumping variables, objects, lists, etc for debugging purposes '======================================================================================================================= Class DataDumper_Class Public Sub Dump(V) put "
"
        DumpIt V
        put "
" End Sub Private m_indent Private Sub Indent m_indent = m_indent + 1 'putl "INDENT: " & m_indent 'puti m_indent 'put_ End Sub Private Sub Dedent m_indent = m_indent - 1 'putl "INDENT: " & m_indent End Sub Private Sub Class_Initialize m_indent = -1 'first indent takes it to 0 End Sub 'prepends indents Private Sub puti(v) put Spaces(m_indent) & v End Sub Private Sub DumpIt(V) If Typename(V) = "LinkedList_Class" then DumpList V ElseIf Instr(Typename(V), "_Class") > 0 then DumpClass V ElseIf Typename(V) = "Variant()" then DumpArray V ElseIf Typename(V) = "Recordset" then DumpRecordset V Else put "«" & H(V) & "»" End If End Sub Private Sub DumpList(V) Indent dim it : set it = V.Iterator dim item dim i : i = 1 put_ puti "[List:" & vbCR While it.HasNext Indent set item = it.GetNext() puti i & " => " DumpIt item put_ Dedent i = i + 1 Wend puti "]" Dedent End Sub Private Sub DumpArray(V) Indent dim i put_ puti "[Array:" & vbCR Indent For i = 0 to UBound(V) puti i & " => " DumpIt V(i) put_ Next Dedent puti "]" Dedent End Sub Private Sub DumpClass(C) Indent dim i put_ puti "{" & Typename(C) & ": " & vbCR Indent On Error Resume Next If Ubound(C.Class_Get_Properties) > 0 then dim property_name, the_property For i = 0 to UBound(C.Class_Get_Properties) property_name = C.Class_Get_Properties(i) Execute "Assign the_property, C." & C.Class_Get_Properties(i) 'put "property_name: " & property_name & " (" & typename(the_property) & ")" & vbCR If typename(the_property) = "LinkedList_Class" then puti " " & property_name & " : LinkedList_Class => " DumpList(the_property) ElseIf InStr(typename(the_property), "_Class") then puti " " & property_name & " : " & typename(the_property) & " => " DumpClass(the_property) Else puti " " & property_name & " : " & typename(the_property) & " => " '& Eval("C." & property_name) DumpIt(the_property) If i <> UBound(C.Class_Get_Properties) then put ", " put vbCR End If Next Else End If On Error Goto 0 Dedent puti "}" & vbCR & vbCR Dedent End Sub Sub DumpRecordset(R) Indent dim field put "" put "" For each field in R.Fields put "" Next put "" Do until R.EOF put "" For each field in R.Fields put "" Next put "" R.MoveNext Loop put "
" & field.Name & "
" & H(R(field.Name)) & "
" Dedent End Sub Private Function Spaces(num) dim s : s = "" dim i For i = 1 to num s = s & " " Next Spaces = s End Function End Class dim DataDumper_Class__Singleton Sub Dump(V) If IsEmpty(DataDumper_Class__Singleton) then set DataDumper_Class__Singleton = new DataDumper_Class End If DataDumper_Class__Singleton.Dump V End Sub '======================================================================================================================= ' Strings '======================================================================================================================= 'Capitalizes first word of the_string, leaves rest as-is Function Capitalize(the_string) Capitalize = ucase(left(the_string, 1)) & mid(the_string, 2) End Function '----------------------------------------------------------------------------------------------------------------------- Function Wrap(s, prefix, suffix) Wrap = prefix & s & suffix End Function '======================================================================================================================= ' Logic (i.e. decisions, searches, etc) '======================================================================================================================= 'TODO: Expand this to accept arbitrary sets, e.g. string, recordset, dictionary, list, etc. Function Contains(data, value) Contains = false dim idx select case typename(data) case "String" Contains = Choice(instr(data, value) > 0, true, false) case "Variant()" for idx = lbound(data) to ubound(data) if value = data(idx) then Contains = true exit for end if next case else Err.Raise 9, "mvc.helpers#Contains", "Unexpected type 'data', received: " & typename(data) end select End Function '----------------------------------------------------------------------------------------------------------------------- 'Boolean type checkers 'Don't forget IsArray is built-in! Function IsString(value) IsString = Choice(typename(value) = "String", true, false) End Function Function IsDict(value) IsDict = Choice(typename(value) = "Dictionary", true, false) End Function Function IsRecordset(value) IsRecordset = Choice(typename(value) = "Recordset", true, false) End Function Function IsLinkedList(value) IsLinkedList = Choice(typename(value) = "LinkedList_Class", true, false) End Function '----------------------------------------------------------------------------------------------------------------------- Sub Destroy(o) if isobject(o) then if not o is nothing then on error resume next o.close on error goto 0 set o = nothing end if end if End Sub '----------------------------------------------------------------------------------------------------------------------- Sub Quit response.end End Sub Sub Die(msg) put "" & msg & "" Quit End Sub '----------------------------------------------------------------------------------------------------------------------- Sub DumpSession put "SESSION" & "
" dim session_item for each session_item in session.contents put "" & session_item & " : " & session.contents(session_item) & "
" next End Sub '======================================================================================================================= ' Adapted from Tolerable library '======================================================================================================================= ' This subroutine allows us to ignore the difference ' between object and primitive assignments. This is ' essential for many parts of the engine. Public Sub Assign(ByRef var, ByVal val) If IsObject(val) Then Set var = val Else var = val End If End Sub ' This is similar to the ? : operator of other languages. ' Unfortunately, both the if_true and if_false "branches" ' will be evalauted before the condition is even checked. So, ' you'll only want to use this for simple expressions. Public Function Choice(ByVal cond, ByVal if_true, ByVal if_false) If cond Then Assign Choice, if_true Else Assign Choice, if_false End If End Function ' Allows single-quotes to be used in place of double-quotes. ' Basically, this is a cheap trick that can make it easier ' to specify Lambdas. Public Function Q(ByVal input) Q = Replace(input, "'", """") End Function Public Function PadLeft(originalString,desiredLength,Char) Dim padLength padLength = desiredLength - Len(originalString) If padLength > 0 Then ' Left pad the string with zeros PadLeft = String(padLength, Char) & originalString Else ' If the original string is already longer or equal to the desired length, no padding is needed PadLeft = originalString End If End Function %>