<%
Dim fieldnames(100), fieldvalues(100), fieldcount, fieldtypes(100)
Dim TemplateDisplay
Dim TemplateRS
Dim TableFlag
Dim cdescription
dim tokenformat
dim tokens(5)
dim tokencount
'***********************************************************************
' VP-ASP 4.50 Merge templates with database
' April 19, 2002
' add formatcustomerprice
'**********************************************************************
' Template handling Version 3.0
' "ADD_OITEMS"
' "ADD_PAGEHEADER"
' "ADD_PAGETRAILER"
' "SPECIAL_ORDERBUTTON"
' "SPECIAL_CHECKBOX"
' "ADD_FORMSTART"
' "ADD_FORMEND"
' "ADD_PRODUCTFEATURES"
' "ADD_QUANTITY"
' "ADD_ORDERBUTTON"
' "ADD_CHECKBOX"
' "ADD_TABLE"
' "ADD_TABLEEND"
' "ADD_PRODUCT"
' "ADD_CROSSSELLING"
' "file=filename INCLUDE"
' "field=fieldname INCLUDE
'
' Does field substitution from database to a text template
' TemplateDisplay Yes = output to browser
' No put into array
'**********************************************************
'**************************************************************
' filename to be opened
' rc=4 if file cannot be found
' returns fsObj and RecordObj
'*************************************************************
Sub OpenInputFile (filename, fsObj, RecordObj, rc)
on error resume next
Dim whichfile
whichfile=server.mappath(filename)
set fsObj = Server.CreateObject("Scripting.FileSystemObject")
set RecordObj= fsObj.OpenTextFile(whichfile, 1, False)
If err.number > 0 then
rc=4
fsObj.close
set fsObj=nothing
else
rc=0
' debugwrite whichfile & " opened ok "
end if
End sub
'
' close a file
Sub CloseFile (fsObj, RecordObj, rc)
set RecordObj = nothing
set fsObj = nothing
rc=0
end sub
'
' reads and entire file template into a memory array
'
' creates and array of converted records
Sub ShopTemplateArray(Filename, RS, Outarray, Outcount)
Dim i
Dim NewRecord
Dim fs,ts
Dim rc
Dim Bypass
Dim tempcount
TemplateDisplay="No"
GetFieldValues (RS)
TemplateRS=RS
dim Temparray
tempcount=ubound(outarray)
redim temparray(tempcount)
outcount=0
OpenInputFile Filename, fs, ts, rc
If rc> 0 then
Response.write getconfig("xfont") & LangReadFail & filename & " "
exit sub
end if
ReadEntireFile ts, Tempcount, TempArray
CloseFile fs,ts, rc
for i = 0 to tempcount - 1
Substitute Temparray(i), NewRecord, Bypass
If Bypass=False then
OutArray(outcount)=NewRecord
outcount=outcount+1
end if
next
end sub
'
'****************************************************************
' writes each record to browser
'***************************************************************
Sub ShopTemplateWrite(Filename, RS, orc)
Dim i
Dim NewRecord
Dim recordObj, FsObj
dim rc
Dim MyText
dim readcount
Dim Bypass
readcount=0
GetFieldValues (RS)
TemplateRS=RS
TemplateDisplay="Yes"
OpenInputFile Filename, fsObj, RecordObj, rc
If rc> 0 then
Response.write getconfig("xfont") & LangReadFail & filename & " "
orc=4
exit sub
end if
ReadARecord RecordObj, MyText, rc
Do while rc=0
Substitute MyText, NewRecord, bypass
If Bypass=False then
Response.write NewRecord
end if
'debugwrite "old=" & Mytext & " new=" & NewRecord
readcount=readcount+1
ReadARecord RecordObj, MyText, rc
' Response.write Server.HTMLEncode(mytext) & " "
Loop
CloseFile fsObj,RecordObj, rc
orc=0
end sub
'
Sub ReadEntireFile (RecordObj, readcount, readarray)
'on error resume next
dim rc
dim mytext
rc=0
readcount=0
ReadARecord RecordObj, MyText, rc
'Response.write Server.HTMLEncode(mytext) & " "
'Debugwrite myText
Do while rc=0
readarray(readcount)=mytext
readcount=readcount+1
ReadARecord RecordObj, MyText, rc
' Response.write Server.HTMLEncode(mytext) & " "
Loop
end sub
'
Sub ReadARecord (RecordObj, record, rc)
if RecordObj.AtEndofStream then
rc=4
exit sub
end if
record = RecordObj.readline
rc=0
End Sub
Function Find_Replace(srchString, FndString, InsertString, strend )
Dim i, LastChar, Next_Pos
Dim CurrentPos, LastPos
Dim tempstring
If strend > 0 Then
LastChar = strend
Else
LastChar = Len(srchString)
End If
tempstring = srchString
Next_Pos = 0
Next_Pos = InStr(Next_Pos + 1, tempstring, FndString)
Do Until (Next_Pos = 0) Or (Next_Pos > LastChar)
tempstring = Left(tempstring, Next_Pos - 1) & InsertString & Right(tempstring, (Len(tempstring) - Len(FndString) - (Next_Pos - 1)))
LastChar = LastChar - Len(FndString) + Len(InsertString)
Next_Pos = 0
Next_Pos = InStr(Next_Pos + 1, tempstring, FndString)
Loop
Find_Replace = tempstring
End Function
'
Sub Substitute (inrecord, workrecord, Bypass)
' values can be any field in the products table
' or special keywords
' [field]
' [
Dim rc
Dim morefields
Dim dbindex
Dim dbfieldname
Dim dbvalue
Dim dbvalue1
Dim token
Dim Newrecord
Dim fieldfound
Dim pos
Dim endpos
Dim specchar
Dim dbvalue2
Dim firstchar
Dim length
pos = 1
Bypass=False
'Response.write "converting " & Server.HTMLEncode(inrecord) & " "
workrecord = inrecord
morefields = True
fieldfound = False ' used to determine if record is ouput if starts with a $
firstchar = Left(workrecord, 1) ' save first character
Do While morefields = True
pos = InStr(pos, workrecord, "[")
If pos > 0 Then
endpos = InStr(pos, workrecord, "]")
If endpos=0 then
WriteError "Missing ] on field starting at " & Pos
morefields=false
else
length = endpos - pos + 1
tokenformat=""
token = Mid(workrecord, pos, length)
specchar = Mid(token, 2, 1)
dbfieldname = Mid(token, 2, length - 2)
parserecord dbfieldname, tokens, tokencount, " "
if tokencount> 1 then
dbfieldname=tokens(1)
tokenformat=ucase(tokens(0)) ' formatcurrency, formatnumber
'debugwrite "tokenformat=" & tokenformat & " token=" & token
end if
FindField dbfieldname, dbvalue, rc
If rc > 0 Then Exit Sub
Newrecord = Find_Replace(workrecord, token, dbvalue, 0)
If dbvalue <> "" Then
fieldfound = True ' used to determine if record written
End If
workrecord = Newrecord
end if
Else
morefields = False
End If
Loop
' at this point if record starts with a $ and no fields substituted, do not write it
If firstchar = "$" Then
If fieldfound = False Then
workrecord=""
Bypass=True
Exit Sub
Else
length = Len(workrecord) - 1
Newrecord = Mid(workrecord, 2, length)
workrecord = Newrecord
bypass=False
End If
End If
Bypass=False
End Sub
Sub WriteError (msg)
Response.write getconfig("xfont") & msg & " "
end sub
'
Private Sub FindField(fieldname, value, rc)
Dim i
Dim temparea
Dim ucfieldname
Dim Fieldtype
'On error resume next
ucfieldname = UCase(fieldname)
rc = 0
ProcessKeyword ucfieldname, value, rc
If rc = 0 Then Exit Sub
rc = 0
FindInDatabase ucfieldname, temparea, fieldtype ,rc
If rc > 0 then
WriteError "Field " & fieldname & " " & LangDatabaseFail
value=""
exit sub
end if
If temparea="" then
value=""
exit sub
end if
' debugwrite fieldname & " type=" & fieldtype & " " & temparea
DoSpecialFormating temparea, tokenformat
value = temparea
End Sub
'
Sub FindInDatabase (fieldname, fieldvalue, fieldtype, rc)
dim i
for i=0 to fieldcount
if fieldname=Fieldnames(i) then
fieldvalue=fieldvalues(i)
fieldtype=fieldtypes(i)
rc=0
'debugwrite fieldname & " found =" & fieldvalue
exit sub
end if
next
rc=4
fieldvalue=""
end sub
Sub GetIdField (table, idfield)
dim utable
idfield=""
utable=Ucase(table)
Select Case utable
Case "ORDERS"
idfield="ORDERID"
Case "CUSTOMERS"
idfield="CONTACTID"
Case "CATEGORIES"
idfield="CATEGORYID"
Case "PRODUCTS"
idfield="CATALOGID"
Case "SUBCATEGORIES"
idfield="SUBCATEGORYID"
Case "SETUPID"
idfield="SUBCATEGORYID"
Case "SHIPMETHODS"
idfield="SHIPMETHODID"
Case "AFFILIATES"
idfield="AFFID"
Case "PROJECTS"
idfield="PID"
end select
end sub
Sub ProcessKeyword (keyword, value, rc)
rc=4
Select Case keyword
Case "ADD_OITEMS"
Handle_OITEMS value
rc=0
Case "ADD_PAGEHEADER"
Handle_PAGEHEADER value
rc=0
Case "ADD_PAGETRAILER"
Handle_PageTrailer value
rc=0
Case "SPECIAL_ORDERBUTTON"
Handle_SpecialOrderButton value
rc=0
Case "SPECIAL_CHECKBOX"
Handle_SpecialCheckbox value
rc=0
Case "ADD_FORMSTART"
Handle_FormStart "User","shopaddtocart.asp"
rc=0
Case "ADD_FORMEND"
Handle_FormEnd "User"
rc=0
Case "ADD_PRODUCTFEATURES"
Add_ProductFeatures "User",""
rc=0
Case "ADD_QUANTITY"
Add_Quantity "User"
rc=0
Case "ADD_ORDERBUTTON"
Add_Button "User"
rc=0
Case "ADD_CHECKBOX"
Add_Checkbox "User"
rc=0
Case "ADD_TABLE"
Add_Table "User"
rc=0
Case "ADD_TABLEEND"
Add_TableEnd "User"
rc=0
Case "ADD_PRODUCT"
Add_Product "User"
rc=0
Case "INCLUDE"
Handle_Include value
rc=0
Case "ADD_CROSSSELLING"
Handle_CROSSSELLING value
rc=0
Case "SUB"
Handle_Product ucase(tokenformat)
rc=0
end select
end sub
Sub DoSpecialFormating (value, tokenformat)
If tokenformat="" then exit sub
dim strprice
Select Case tokenformat
Case "FORMATCURRENCY"
value = shopformatcurrency(value,getconfig("xdecimalpoint"))
Case "DUALPRICE"
ConvertCurrency value, strPrice
value = formatnumber(strprice,getconfig("xdecimalpoint"))
Case "FORMATNUMBER"
value = formatnumber(value,getconfig("xdecimalpoint"))
Case "FORMATDATE"
value = shopdateformat(value,getconfig("xdateformat"))
Case "FORMATCUSTOMERPRICE"
value = HandleCustomerPrice(value)
Case "URLENCODE"
value = server.urlencode(value)
End Select
end sub
'
Sub Handle_OITEMS (body)
'*******************************************************
' Template format order items
' expects myconn to be open as open connection
'********************************************************
Dim Isql, deliveryaddress, deliveryarray
dim orderid
Dim rsitems
Dim Dbc
Dim CR, itemname
If ucase(Getsess("emailformat"))="HTML" then
CR=" "
else
CR = GetMailCR
end if
'OpenOrderdb dbc
isql="select * from oitems where orderid="
If Getsess("oid")<>"" then
Orderid=GetSess("oid")
else
Orderid=TemplateRS(0)
end if
Body=""
ISql=Isql & Orderid
'debugwrite isql
Set rsitems=myconn.execute(Isql)
Do While Not RSItems.EOF
itemname=rsitems("itemname")
if getconfig("xdeliveryaddress")="Yes" then
deliveryaddress=rsitems("address")
If not isnull(Deliveryaddress) and Deliveryaddress<>"" then
ConvertDeliveryToArray DeliveryArray, Deliveryaddress
GetDeliveryName Itemname, DeliveryArray
end if
end if
If ucase(Getsess("emailformat"))<>"HTML" then
Itemname=RemoveHtmlFileio(itemname, CR)
end if
Body = Body & CR & Itemname & CR
Body = Body & LangProductQuantity & ": " & RSItems("numitems") & CR
If getconfig("xDisplayPrices")<>"No" then
Body = Body & LangProductPrice & ": " & shopformatcurrency(RSItems("unitprice"),getconfig("xdecimalpoint")) & CR
end if
RSItems.MoveNext
Loop
rsitems.close
Set rsitems=nothing
'Shopclosedatabase dbc
end sub
'
'
'
Sub ShopReadEntireFile(Filename, Outarray, Outcount)
Dim i
Dim NewRecord
Dim fs,ts
Dim rc
outcount=0
OpenInputFile Filename, fs, ts, rc
If rc> 0 then
exit sub
end if
ReadEntireFile ts, Outcount, OutArray
CloseFile fs,ts, rc
rc=0
end sub
Sub Handle_PageHeader (value)
Value=""
If TemplateDisplay="No" then exit sub
ShopPageHeader
end sub
Sub Handle_PageTrailer (value)
Value=""
If TemplateDisplay="No" then exit sub
ShopPageTrailer
end sub
'
Sub Handle_SpecialOrderButton (ivalue)
Handle_FormStart ivalue,"shopaddtocart.asp"
Add_Table ""
prodindex=""
Add_ProductFeatures "",""
Add_Quantity ""
Add_Button ""
Add_Product ""
Add_TableEnd ""
Handle_FormEnd ""
end sub
Sub Add_Product (ivalue)
Dim Id, fieldtype, rc
dim fieldname
fieldname="CATALOGID"
id=0
FindInDatabase fieldname, Id, fieldtype ,rc
If rc > 0 then
WriteError "Field " & fieldname & " " & LangDatabaseFail
end if
%>
<%
end sub
'
Sub Add_Table (ivalue)
WriteForm TemplateTable
TableFlag="True"
end sub
'
Sub Add_TableEnd (ivalue)
WriteForm ""
Tableflag=""
End Sub
'
Sub Handle_SpecialCheckBox (ivalue)
Handle_FormStart ivalue, "shopproductselect.asp"
Add_Table ""
Add_ProductFeatures "","0"
Add_Quantity ""
Add_CheckBox ""
Add_Button ""
Add_TableEnd ""
Add_ProductIndex ""
Handle_FormEnd ""
end sub
Sub Add_ProductIndex (ivalue)
WriteForm ""
end sub
'
Sub Add_CheckBox (ivalue)
Dim Id, fieldname,fieldtype, rc
fieldname="CATALOGID"
FindInDatabase fieldname, Id, fieldtype ,rc
If rc > 0 then
WriteError "Field " & fieldname & " " & LangDatabaseFail
end if
If TableFlag<>"" then
Response.write TemplateCheckboxRow & TemplateCheckboxColumn
end if
WriteForm ""
if TableFlag<>"" then
WriteForm TemplateCheckboxColumnEnd
Response.write ""
end if
end sub'
Sub Add_Button (ivalue)
dim mytext, mybutton
dim fieldvalue
dim rc
Dim Id, fieldname,fieldtype
WriteNoStockMessage rc
if rc> 0 then exit sub
fieldname="CATALOGID"
FindInDatabase fieldname, Id, fieldtype ,rc
If rc > 0 then
WriteError "Field " & fieldname & " " & LangDatabaseFail
else
ID=0
end if
mytext=getconfig("XButtonText")
if mytext="" then
mytext="Order"
end if
mybutton=""
fieldname="BUTTONIMAGE"
fieldvalue=""
FindInDatabase fieldname, fieldvalue, fieldtype ,rc
if fieldvalue<>"" then
mybutton= fieldvalue
else
if getconfig("xButtonImage") <>"" then
mybutton=getconfig("xButtonImage")
end if
end if
if tableflag<>"" then
Response.write TemplateButtonRow & TemplateButtonColumn
end if
If myButton="" then
WriteForm ""
else
WriteForm ""
end if
If tableflag<>"" then
response.write ""
end if
end sub
'
Sub Add_Quantity (ivalue)
dim strminimumquantity, rc
Findfield "Minimumquantity",strminimumquantity, rc
If strminimumquantity="" then
strminimumquantity=0
end if
If strMinimumquantity=0 then
If tableflag<>"" then
Response.write TemplateQuantityRow & TemplateQuantityColumn
end if
%>
<%
If tableflag<>"" then
response.write TemplateQuantityColumnEnd & ""
end if
else
GenerateMinimumList strMinimumquantity
end if
End sub
'
Sub GetFieldValues (RS)
Dim i
dim fldname
i=0
' memo fields must be gotten first
For each fldName in RS.Fields
fieldnames(i) = ucase(fldname.name)
fieldTypes(i) = fldname.type
If Fieldtypes(i)="201" then
fieldvalues(i)=RS(i)
end if
i=i+1
next
fieldcount=i-1
for i=0 to fieldcount
if fieldtypes(i)<>"201" then
fieldvalues(i)=RS(i).value
end if
if isnull(fieldvalues(i)) then
fieldvalues(i)=""
end if
'Debugwrite fieldnames(i) & " " & fieldvalues(i)
next
End Sub
Sub ParseRecord (record,words,wordcount,delimiter)
Dim pos
Dim recordl
Dim bytex
Dim temprec
Dim maxwords
Dim i
maxwords = 10
temprec = record
Dim maxentries
pos = 1
wordcount = 0
' make sure word array is null
maxentries = UBound(words)
For i = 0 To maxentries - 1
words(i) = ""
Next
recordl = Len(temprec)
' first eliminate leading blanks
Do
bytex = Mid(temprec, pos, 1)
While bytex = " " And pos <= recordl
pos = pos + 1
bytex = Mid(temprec, pos, 1)
Wend
' copy word into word array
While bytex <> delimiter And pos <= recordl
words(wordcount) = words(wordcount) & bytex
pos = pos + 1
bytex = Mid(temprec, pos, 1)
Wend
wordcount = wordcount + 1
pos = pos + 1
If wordcount > maxentries Then Exit Sub
Loop Until pos > recordl
End Sub
'
Sub Add_ProductFeatures (ivalue, Index)
dim rc, fieldtype
prodindex=index
FindInDatabase "FEATURES", strfeatures, fieldtype, rc
If rc=0 then
FindInDatabase "SELECTLIST", strselectlist, fieldtype, rc
FindInDatabase "CATALOGID", lngcatalogid, fieldtype, rc
If tableflag<>"" then
WriteForm TemplateFeaturesRow & TemplateFeaturesColumn
end if
FormatProductOptions
if tableflag<>"" then
Writeform TemplateFeaturesColumnEnd & ""
end if
end if
end sub
Sub Handle_FormStart (value, action)
Dim Newaction
newaction="shopaddtocart.asp"
If action<>"" then
newaction=action
end if
%>
"
end sub
Sub WriteForm (text)
Response.write text
end sub
Sub Handle_Include (ivalue)
'******************************************************
'[filename INCLUDE]
' field=abc INCLUDE]
' abc is field in recordset
'******************************************************
Dim NewRecord, ucfieldname
Dim recordObj, FsObj
dim rc
Dim MyText
dim readcount
Dim Bypass, filename, pos, fieldtype, filetype
dim values(10),valuecount
readcount=0
filename=tokens(0)
pos=instr(filename,"=")
if pos>0 then
Parserecord filename,values,valuecount,"="
ucfieldname=ucase(values(1))
if ucase(values(0))="FIELD" then
FindInDatabase ucfieldname, filename, fieldtype ,rc
If isnull(filename) or filename="" then
exit sub
end if
else
filename=values(1)
end if
end if
'debugwrite "filename=" & filename
OpenInputFile Filename, fsObj, RecordObj, rc
If rc> 0 then
Response.write getconfig("xfont") & LangReadFail & filename & " "
exit sub
else
GetFileType filename,filetype
end if
ReadARecord RecordObj, MyText, rc
Do while rc=0
If filetype="TXT" then
Response.write Server.HTMLEncode(MyText) & " "
else
response.write mytext
end if
readcount=readcount+1
ReadARecord RecordObj, MyText, rc
Loop
CloseFile fsObj,RecordObj, rc
end sub
'
Sub GetFileType(filename, filetype)
dim xtype
filetype="TXT"
xtype=ucase(right(filename,3))
Select case xtype
case "TXT"
filetype="TXT"
case "HTM"
filetype="HTM"
case "TML"
filetype="HTM"
end select
end sub
Sub GenerateMinimumList (strminimumquantity)
Dim PArray(10),PArrayCount
dim minamount, amount, multiply
minamount=strminimumquantity
parraycount=6
for i = 1 to parraycount
amount=i*minamount
parray(i)=amount
next
dim i
sSelect = ""
If tableflag<>"" then
Response.write TemplateQuantityRow & TemplateQuantityColumn
end if
Response.write sSelect
If tableflag<>"" then
response.write TemplateQuantityColumnEnd & ""
end if
end sub
Function RemovehtmlFileio(itemname, CR)
dim workrecord, firstchar, morefields, pos, endpos, length
dim token
workrecord=replace(itemname," ",CR)
'If mailremovehtml<>"Yes" then
' Removehtml=workrecord
' exit function
'end if
pos=1
morefields = True
Do While morefields = True
pos=1
pos = InStr(pos, workrecord, "<")
If pos > 0 Then
endpos = InStr(pos, workrecord, ">")
If endpos=0 then
morefields=false
else
length = endpos - pos + 1
token = Mid(workrecord, pos, length)
workrecord=replace(workrecord,token,"")
end if
else
morefields=false
end if
loop
RemovehtmlFileio=workrecord
end function
Sub Handle_CrossSelling (ivalue)
dim strCrossProductIDs,strsql, rs, strmessage, strcdescurl,strurl
dim fieldtype,rc, dbc
FindInDatabase "CROSSSELLING", strcrossProductids, fieldtype, rc
If rc>0 then exit sub
if strCrossProductids="" then exit sub
shopopendatabase dbc
strSQL="Select * From Products Where catalogId IN (" & strCrossProductIDs & ")"
set rs=dbc.execute(strsql)
While Not rs.EOF
strCDescURL=rs("cdescurl")
If isnull(Strcdescurl) then
strCDescURL=getconfig("xCrossLinkURL")
end if
if ucase(strcDESCURL)="SHOPEXD.ASP" then
strurl="shopexd.asp?id=" & rs("catalogid")
else
strurl="shopquery.asp?catalogid=" & rs("catalogid")
end if
strMessage=strMessage & " " & Rs("cname") & ""
RS.MoveNext
WEND
RS.Close
set RS=Nothing
shopclosedatabase dbc
strMessage=" " & LangCrossSellingMessage & strMessage
Response.write strmessage
end sub
Sub WriteNoStockMessage (rc)
dim lngcstock,id,fieldtype,rc1, fieldname
rc=0
if getconfig("xOutOfStockLimit")="" then exit sub
fieldname="CSTOCK"
FindInDatabase fieldname, lngcstock, fieldtype ,rc1
'debugwrite "LNGCSTOCK=" & lngcstock & " " & rc1
if isnull(lngcstock) then exit sub
If lngcstock="" then exit sub
if clng(lngcstock)>clng(getconfig("xOutOfStocklImit")) then exit sub
Response.write OutofStockColumn & LangOutOfStock & OutofStockColumnEnd
rc=4
end sub
Sub ShopMergetemplate (dbtable, template, catalogid, idfield)
dim tempdatabase, tmprs, rc
EditOpenDatabase dbc, tempdatabase, dbtable
'on error resume next
if isnumeric (catalogid) then
Sql="select * from " & dbtable
If idfield<>"" then
sql=sql & " where " & idfield & "=" & catalogid
end if
else
sql="select * from " & dbtable
If idfield<>"" then
sql=sql & " where " & idfield & "='" & catalogid & "'"
end if
end if
Set tmpRS=dbc.execute(sql)
If tmpRS.eof then
If catalogid<>"" then
Serror = SError & LangReadFail & "-" & LangEditTableName & "=" & dbtable
else
Serror = SError & LangReadFail & " " & langedittablename & "=" & dbtable
end if
end if
If serror="" then
ShopTemplateWrite template, tmpRS, rc
end if
CloseRecordset tmpRS
Shopclosedatabase dbc
end sub
'
Function HandleCustomerPrice (iprice)
dim discount, categoryid, ioprice, newprice
newprice=iprice
catalogid=templaterS("catalogid")
categoryid=templateRS("ccategory")
ShopCustomerPrices templateRS, catalogid, categoryid, iprice, newprice,discount
HandleCustomerprice=shopformatcurrency(newprice,getconfig("xdecimalpoint"))
end function
%>