'encode возвращает вместо " " -> "+"
'http://docs.oracle.com/javase/1.4.2/docs/api/java/net/URLEncoder.html
Class HttpBase As ErrorHandlerWJ
Private curdoc As NotesDocument
Private ses As NotesSession
Private isPrintedHeader As Boolean
Private isPrintedEnd As Boolean
Private decoderClass As JavaClass
Private encoderClass As JavaClass
Private encoderObj As JavaObject
Private Contenttype As String
Private msgList List As String
Private msgCount As Long
Private errList List As String
Private errCount As Long
Sub New()
Set ses=New NotesSession
Set curdoc=ses.DocumentContext
Set encoderClass=jSession.Getclass({java/net/URLEncoder})
Set decoderClass=jSession.Getclass({java/net/URLDecoder})
Contenttype={text}
End Sub
Sub Delete
Me.Close
End Sub
Property Get CGIvar(xName As String) As String
CGIvar=curdoc.GetItemValue(xName)(0)
End Property
Private Property Set Content As String
End Property
Property Get GetRequestParams As Variant
On Error Goto ErrH
Dim s As String
s=Fulltrim(GetRequestQuery)
If Len(s)>0 Then
GetRequestParams=Split(s,{&})
Else
s=Fulltrim(GetRequestPost)
If Len(s)>0 Then GetRequestParams=Split(s,{&})
End If
Quit:
Exit Property
ErrH:
Me.PrintError(Me.RaiseError)
Resume Quit
End Property
Property Get GetRequestQuery As String
On Error Goto ErrH
'используется Query_String_Decoded - не чувствует разницы между "+" и " "
'это поведение типично и потому "+" -> " "
GetRequestQuery=curdoc.getItemValue("Query_String_Decoded")(0)
Quit:
Exit Property
ErrH:
Me.PrintError(Me.RaiseError)
Resume Quit
End Property
Property Get GetRequestPost As String
On Error Goto ErrH
GetRequestPost=curdoc.getItemValue("Request_Content")(0)
Quit:
Exit Property
ErrH:
Me.PrintError(Me.RaiseError)
Resume Quit
End Property
Property Get GetRequesPath As String
GetRequesPath=curdoc.getItemValueString("Path_Info_Decoded")
End Property
Sub PrintMsg(msg As String)
PrintHeader
msgList({message_} &Cstr(msgCount))=msg
msgCount=msgCount+1
End Sub
Function Decode(msg As String) As String
Decode=decoderClass.decode(msg)
End Function
Function DecodeUTF8(msg As String) As String
DecodeUTF8=decoderClass.decode(msg,{UTF-8})
End Function
Function DecodeCP1251(msg As String) As String
DecodeCP1251=decoderClass.decode(msg, {Cp1251})
End Function
Function DecodeAll(msg As String, enc As String) As String
DecodeAll=decoderClass.decode(msg, enc)
End Function
Function EncodeAll(msg As String, enc As String) As String
EncodeAll=encoderClass.encode(msg, enc)
End Function
Function Encode(msg As String) As String
Encode=encoderClass.encode(msg)
End Function
Sub PrintMsgEncoded(msg As String)
PrintHeader
msgList({messageEnc_} &Cstr(msgCount))=encoderClass.encode(msg)
End Sub
Private Function PrintHeader As Boolean
On Error Goto ErrH
If isPrintedHeader Then Exit Function
'возвращаем результат в UTF-8
Print {Content-Type: } &Contenttype &{; charset=UTF-8"} 'text/xml;application/xml;
' Print {Content-Type: } &Contenttype &{; charset=Windows-1251"}
isPrintedHeader=True
Me.PrintHeader=True
Quit:
Exit Function
ErrH:
Error Err, RaiseError
End Function
Private Function PrintEnd As Boolean
If Not isPrintedHeader Then Exit Function
If isPrintedEnd Then Exit Function
isPrintedEnd=True
Me.PrintEnd=True
End Function
Private Sub PrintError(msg As String)
PrintHeader
errList({error_} &Cstr(errCount))=msg
errCount=errCount+1
End Sub
Sub Close
PrintEnd
End Sub
End Class
Class HttpBaseXML As HttpBase
Function PrintHeader As Boolean
Dim b As Boolean
b=HttpBase..PrintHeader
Me.PrintHeader=b
If Not b Then Exit Function
Print {<?xml version="1.0" encoding="UTF-8"?>}
Print {<response>}
End Function
Sub New()
Contenttype={text/xml}
End Sub
Sub PrintMsg(msg As String)
PrintHeader
Print {<message>} &msg &{</message>}
End Sub
Sub PrintMsgEncoded(msg As String)
PrintHeader
Print {<messageenc>} &encoderClass.encode(msg) &{</messageenc>}
End Sub
Function PrintEnd As Boolean
Dim b As Boolean
b=HttpBase..PrintEnd
Me.PrintEnd=b
If Not b Then Exit Function
Print {</response>}
End Function
Sub PrintError(msg As String)
Call HttpBase..PrintError(msg)
Print {<error><object>} & Typename(Me) &{</object><message>} &msg &{</message></error>}
End Sub
End Class
Class HttpBaseJSON As HttpBase
Function PrintHeader As Boolean
Dim b As Boolean
b=HttpBase..PrintHeader
Me.PrintHeader=b
If Not b Then Exit Function
' Print |{"response":[|
Print |{|
End Function
Sub New
Contenttype="application/json"
End Sub
Function PrintEnd As Boolean
Dim b As Boolean
b=HttpBase..PrintEnd
Me.PrintEnd=b
If Not b Then Exit Function
' Print |"end":"end"]}|
Print |"end":"end"}|'заглушка, чтобы не заморачиваться на оконечные запятые
End Function
' Sub PrintMsg(msg As String)
' PrintHeader
' Print {"message":"} &msg &{",}
' End Sub
' Sub PrintMsgEncoded(msg As String)
' PrintHeader
' Print {"message_enc":"} &encoderClass.encode(msg) &{",}
' End Sub
Sub PrintJSONvar(xName As String, xValue As String)
PrintHeader
Print {"} &xName &{":"} &xValue &{",}
End Sub
' Sub PrintError(msg As String)
' Call HttpBase..PrintError(msg)
' Print |"error":{"object":"| & Typename(Me) &|", "message":"| &msg &|"},|
' End Sub
Sub Close
'разделим потоки ошибок и сообщений
'выводим ошибки из буфера
Print |errors:[|
Forall e In errList
Print |{"| & Listtag(e) & |":{"object":"| & Typename(Me) &|", "message":"| & e &|"}},|
End Forall
'если первым елементом - errors[0]=="end" - нет ошибок
Print |"end"],| 'зглушка окончания списка ошибок
'выаодим сообщения из буфера
Print |messages:[|
Forall m In msgList
' Print |{"| &Listtag(m) &|":"| &m &|"},|
Print |"| &m &|",|
End Forall
'если первым елементом - messages[0]=="end" - нет сообщений
Print |"end"],| 'заглушка окончания списка сообщений
HttpBase..Close
End Sub
End Class
Class HttpObj As HttpBaseJSON
End Class
