Subversion Repositories DevTools

<%@LANGUAGE="VBSCRIPT"%>

<%

'=====================================================

'   _json_Notifications.asp

'   Ajax support Package Notification Manipulation

'       updateProjects

'

'=====================================================

%>

<%

Option explicit

' Essential to get UTF through all the hoops. ie: VÄSTTRAFIK (VTK)

Response.ContentType = "text/html"

Response.AddHeader "Content-Type", "text/html;charset=UTF-8"

Response.CodePage = 65001

Response.CharSet = "UTF-8"

%>

<!--#include file="common/conf.asp"-->

<!--#include file="common/globals.asp"-->

<!--#include file="common/qstr.asp"-->

<!--#include file="common/common_subs.asp"-->

<!--#include file="_access_control_general.asp"-->

<SCRIPT LANGUAGE="VBScript" RUNAT=SERVER SRC="class/classaspJSON.vbs"></SCRIPT> 

<%

'------------ Variable Definition -------------

Dim parOpr

Dim result

Dim SqlQry

Dim rsQry

parOpr = QStrPar("Opr")

' Init the output JSON class

'   Operations can add data

'   Default data will be added at the end

Dim oJSON

Set oJSON = New aspJSON

Dim newitem

Function canModify

    canModify = canActionInProject()

    If NOT canModify Then

        result = -4

        oJSON.data("error") = 1

        oJSON.data("emsgSummary") = "Permission denied"

        oJSON.data("emsgDetails") = oJSON.data("emsgSummary")

    End If

End Function

'

'   Prefill error indications

'   

result = -1

oJSON.data("emsgSummary") = "JSON Operation:" & parOpr

oJSON.data("emsgDetails") = "Internal Problem. Error not reported" 

'   

'   Perform the body of the operations within a Sub and use

'   On Error Resule Next to catch errors that accur in the code

'

On Error Resume Next

If (parOpr = "updateProjects") Then

    If canModify() Then updateProjects

Else

    oJSON.data("error") = 1

    oJSON.data("emsgSummary") = "Unknown JSON Operation"

    oJSON.data("emsgDetails") = "JSON operation is not supported: " & parOpr

End If

' SQL error detection and reporting

If objEH.LastOraFailed Then

    oJSON.data("error") = 1

    result = -1

    oJSON.data("emsgSummary") = objEH.MessageSummary

    oJSON.data("emsgDetails") = objEH.MessageDetails

    oJSON.data("SqlQry") = SqlQry

'

'   Detect program errors

ElseIf Err.number <> 0 Then

    result = -3

    oJSON.data("error") = 2

    oJSON.data("errnum") = Err.number

    oJSON.data("errtxt") = Err.description

    oJSON.data("errsrc") = Err.source

    oJSON.data("emsgSummary") = "Internal VBScript Error:"

    oJSON.data("emsgDetails") = Err.number &  ":" & Err.description

End If

On error goto 0

'Write single value

oJSON.data("result") = result

If result = 0 Then

    oJSON.data.Remove("emsgSummary")

    oJSON.data.Remove("emsgDetails")

End If

'function Sleep(seconds)

'    dim oshell, cmd

'    set oShell = CreateObject("Wscript.Shell")

'    cmd = "cmd.exe /c timeout " & seconds & " /nobreak"

'    oShell.Run cmd,0,1

'End function

'

'Sleep(2)

' DEBUG: A Hash of the user provided requests

<!--oJSON.data("QueryString") = Request.QueryString       -->

<!--                                                      -->

<!--Dim requestSet : Set requestSet = oJSON.Collection()  -->

<!--Set oJSON.data("Request") = requestSet                -->

<!--Dim variableName                                      -->

<!--for each variableName in Request.QueryString          -->

<!--    requestSet.add variableName, Request(variableName)-->

<!--next                                                  -->

<!--for each variableName in Request.Form                 -->

<!--    requestSet.add variableName, Request(variableName)-->

<!--next                                                  -->

'Return the object

Response.Write oJSON.JSONoutput()

Set oJSON = Nothing

Call Destroy_All_Objects

%>

<%

'-------------------------------------------------

' Function:    updateProjects

' Description: Add/Del the Named projects to the current users notification list

'              pkg_id   - Package to process

'              alist    - comma seperated list of projects to add

'              rlist    - comma seperated list of projects to remove

Sub updateProjects

    Dim  parPkgId : parPkgId = QStrPar("pkg_id")

    Dim  parAlist : parAlist = QStrPar("alist")

    Dim  parRlist : parRlist = QStrPar("rlist")

    If parPkgId <> "" Then

        Dim arrAfield : arrAfield=Split(parAlist,",")

        Dim arrRfield : arrRfield=Split(parRlist,",")

        Dim elem

        objEH.ErrorRedirect = FALSE

        objEH.TryORA ( OraSession )

        On Error Resume Next

        OraDatabase.Parameters.Add "PROJ_ID",	0, ORAPARM_INPUT, ORATYPE_NUMBER

        OraDatabase.Parameters.Add "PKG_ID",	parPkgId, 	ORAPARM_INPUT, ORATYPE_NUMBER

        OraDatabase.Parameters.Add "USER_ID", 	objAccessControl.UserId, ORAPARM_INPUT, ORATYPE_NUMBER

        For each elem in arrAfield

            OraDatabase.Parameters("PROJ_ID").value = elem

        	OraDatabase.ExecuteSQL "BEGIN ADD_PACKAGE_INTEREST ( :PROJ_ID, :PKG_ID, :USER_ID ); END;"

        Next

        For each elem in arrRfield

            OraDatabase.Parameters("PROJ_ID").value = elem

        	OraDatabase.ExecuteSQL "BEGIN REMOVE_PACKAGE_INTEREST ( :PROJ_ID, :PKG_ID, :USER_ID ); END;"

        Next

        OraDatabase.Parameters.Remove "PROJ_ID"

        OraDatabase.Parameters.Remove "PKG_ID"

        OraDatabase.Parameters.Remove "USER_ID"

        objEH.CatchORA ( OraSession )

        result = 0

    Else

        oJSON.data("emsgSummary") = "addProjects"

        oJSON.data("emsgDetails") = "Insufficient arguments"

    End If

End Sub

%>