[1]Function Defect_AccessControl(actionname, actiontype,
username)
'actionname As String
'actiontype As Long
'username As String
'Defect_AccessControl As Boolean
'action = Close
‘Purpose: Allow the submitter or a member of the pmgr
group to close a SCR from the qualify state.
Dim is_ok
Dim
CurrState
Dim
ResultSet
Dim Sess
Dim
Submitter
Dim
userGroups
is_ok =
False
CurrState =
GetFieldValue("State").GetValue()
If
CurrState <> "Qualify" then
is_ok
= True
Else
set
sessionObj = GetSession
submitter
= GetFieldValue("Submitter").GetValue
If
submitter = username then
is_ok
= True
Else
userGroups
= sessionObj.GetUserGroups
If
IsEmpty(userGroups) then
Else
For
Each group in userGroups
If
group = "pmgr" then
is_ok
= True
End
if
Next
end
if
End
if
End if
Defect_AccessControl
= is_ok
End Function
[2]Sub Defect_Initialization(actionname, actiontype)
'actionname As String
'actiontype As Long
'action = Close
‘Purpose: Set the closed date to the current date when a SCR is closed.
SetFieldValue "close_date",
Now()
End Sub
[3] Function Defect_Validation(actionname, actiontype)
' actionname As String
' actiontype As Long
‘ Defect_Validation As String
' action = Close
Dim DaysOpen
DaysOpen =
DateDiff("d", GetFieldValue("Submit_Date").GetValue,
GetFieldValue("close_date").GetValue)
SetFieldValue
"days_open", DaysOpen
End Function
[4]Sub Defect_Initialization(actionname, actiontype)
‘actionname As String
'actiontype As Long
‘action = Re_open
‘Purpose: Clear the closed date if the SCR is reopened.
SetFieldValue "close_date",
""
End Sub
[5]Sub Defect_Initialization(actionname, actiontype)
'actionname As String
'actiontype As Long
'action = Verify
‘Purpose: Set the verification date to the current date if the Verify
action is applied to a SCR.
setFieldValue
"verification_date", now()
End Sub
[6]Function Defect_Validation(actionname, actiontype)
‘actionname As String
‘actiontype As Long
'Defect_Validation As String
‘action = Verify
on error resume next
err.clear
‘Purpose: Set the closed date to the current date and
calculate the days open.
Dim DaysOpen
SetFieldValue
"close_date", GetFieldValue("verification_date").GetValue
DaysOpen =
DateDiff("d",GetFieldValue("Submit_Date").GetValue,GetFieldValue("close_date").GetValue)
SetFieldValue
"days_open", DaysOpen
End Function
[7] Sub Defect_Commit(actionname, actiontype)
'
actionname As String
' actiontype As Long
' action = Duplicate
on
error resume next
err.clear
' Purpose: When the Duplicate action is invoked,
' child
calls are linked to parent.
' Inputs: Duplicate action.
' Returns: None
'
' Fields: None
' Forms: None
'
' Global Scripts: BuildErrMsg,
DisplayErrMsg, GetActions, IsDataValid, IsDefectEditable
'
' Notes: 1. The parent is the original
record. The child is the
' record
marked as a duplicate of the original.
' 2.
Duplicate Calls will not be linked to parent.
' 3.
Duplicate processing i.e. marking a record as a duplicate
' will
always complete regardless of whether an error occurs when
' linking
child Calls to parent.
' 4.
Calls will be linked to parent if parent is a
' duplicate.
' 5.
If parent is not in an editable state, linking calls
' requires
multiple transactions. Transition parent to an editable
' state,
link calls to parent, transition parent back to
' original
state. Also, each state transition requires a separate
' transaction.
' 6.
When an error message is displayed in a msgbox,
' commit
and revert processing is delayed until
' user
clicks OK. This is the same as online
' ClearQuest
processing.
' 7.
The msgbox function is only used on the Windows client.
' On
the Web client, the msgbox function will cause the
' Web
to hang. The dialog box pops up on the server’s
' screen
where no one is available to click OK.
' 8.
Why implement as an Action_Commit Hook and not in as a Validation Hook?
' If
the link Calls code is implemented as a function in
' the
Validation Hook and error messages
returned from the function,
' the
Duplicate action fails.
'
Const cntValidateErr = 0
Const cntTransitionErr =
1
Const cntOtherErr = 2
Const
cntTransitionBackErr = 3
Const cntDuplicateErr =
4
Const
cntValidateAfterErr = 5
Dim blnDebug '
display debug messages
Dim blnWebClient '
indicates whether user is running the Web client
Dim childCallLinks '
child linked calls
Dim i
Dim intDirection '
direction to transition parent; 1 editable, 0 non editable
Dim NL '
newline
Dim
originalObj
Dim oldStrParentState
Dim objParent
Dim
parentCallLinks '
parent linked calls
Dim
parentUnduplicateState
Dim parentRefList '
parent's linked calls returned in a list format
Dim refList '
child's linked calls returned in a list format
Dim
sessionObj
Dim strActionArray() '
actions to transition parent to editable state
Dim strChildID
Dim strErrArray(4) '
error messages
Dim strMyRetValue '
hold return value from my functions
Dim strRetValue '
hold return value from ClearQuest functions
Dim strParentID
Dim strParentState
'
------------------------------------------------------------------------------------------------------------
NL = vbcrlf
strErrArray(cntValidateErr)
= "Error Number=1" & vbtab & "Missing or invalid data
detected." & NL & NL
strErrArray(cntValidateErr)
= strErrArray(cntValidateErr) & "Calls have not been linked."
& NL
strErrArray(cntValidateErr)
= strErrArray(cntValidateErr) & "Fix or enter missing data on parent
record and link calls." & NL
strErrArray(cntTransitionErr)
= "Error Number=2" & vbtab & "Invalid state
transition." & NL & NL
strErrArray(cntTransitionErr)
= strErrArray(cntTransitionErr) & "Calls have not been linked."
& NL
strErrArray(cntTransitionErr)
= strErrArray(cntTransitionErr) & "Parent may be in the last state to
which it was transitioned." & NL & NL
strErrArray(cntTransitionErr)
= strErrArray(cntTransitionErr) & "Report to System
Administrator!" & NL
strErrArray(cntOtherErr)
= "Error Number=3" & vbtab & "Error validating parent
record." & NL & NL
strErrArray(cntOtherErr)
= strErrArray(cntOtherErr) & "Required values missing for state
transition or invalid data detected." & NL & NL
strErrArray(cntOtherErr)
= strErrArray(cntOtherErr) & "Calls have been linked. You must transition " & NL
strErrArray(cntOtherErr)
= strErrArray(cntOtherErr) & "parent to its original state."
& NL
strErrArray(cntTransitionBackErr)
= "Error Number=4" & vbtab & "Error transitioning parent
back to original state." & NL & NL
strErrArray(cntTransitionBackErr)
= strErrArray(cntTransitionBackErr) & "Calls have been linked."
& NL
strErrArray(cntTransitionBackErr)
= strErrArray(cntTransitionBackErr) & "Parent may be in the last state
to which it was transitioned." & NL
strErrArray(cntTransitionBackErr)
= strErrArray(cntTransitionBackErr) & "Report to System
Administrator!" & NL
strErrArray(cntDuplicateErr)
= "Error Number=5" & vbtab & "Error marking parent as a
duplicate." & NL & NL
strErrArray(cntDuplicateErr)
= strErrArray(cntDuplicateErr) & "Calls have been linked." &
NL
strErrArray(cntDuplicateErr)
= strErrArray(cntDuplicateErr) & "Parent is in the unduplicate
state." & NL
strErrArray(cntDuplicateErr)
= strErrArray(cntDuplicateErr) & "Mark parent as a duplicate of
parent." & NL & NL
strErrArray(cntDuplicateErr)
= strErrArray(cntDuplicateErr) & "Report to System
Administrator." & NL
strErrArray(cntValidateAfterErr)
= "Error Number=6" & vbtab & "Missing data required for
state transition." & NL & NL
strErrArray(cntValidateAfterErr)
= strErrArray(cntValidateAfterErr) & "Calls have been linked."
& NL
strErrArray(cntValidateAfterErr)
= strErrArray(cntValidateAfterErr) & "Enter missing data on parent and
transition to original state." & NL
blnDebug = False
blnWebClient =
Check_Web()
strChildID =
GetFieldValue("id").GetValue()
strParentID =
GetOriginalID
Set sessionObj =
GetSession
sessionObj.NameValue
"strSessionValue", "LinkCalls"
Set objParent =
sessionObj.GetEntity("Defect", strParentID)
strParentState =
objParent.GetFieldValue("state").GetValue()
parentCallLinks =
objParent.GetFieldValue("Customer_link").GetValue()
childCallLinks =
GetFieldValue("Customer_link").GetValue()
If blnDebug and Not
blnWebClient Then
msgbox
"parentState = " & strParentState
msgbox
"parentCallLinks = " & parentCallLinks
msgbox
"childCallLinks = " & childCallLinks
End If
' If Calls on parent and
child are not equal, link Calls.
If
GetFieldValue("Customer_link").GetValueStatus = AD_HAS_VALUE _
and (parentCallLinks
<> childCallLinks) Then
If blnDebug
and Not blnWebClient Then
msgbox
"Web Client= " & blnWebClient
msgbox
"Linking Calls"
End If
' If parent
is a Duplicate, unmark as Duplicate to link Calls. Parent will be in its
unduplicate state.
'
' Validate
Error (Error 1)
' If invalid
data is detected, user should unduplicate parent, fix data, link Calls, and
mark as a duplicate.
If
strParentState = "Duplicate" Then
originalID
= objParent.GetOriginalID
Set
objOriginal = sessionObj.GetEntity("Defect", originalID)
If
blnDebug and Not blnWebClient Then
msgbox
"original id = " & originalID
End
If
sessionObj.UnmarkEntityAsDuplicate
objParent, "Unduplicate"
strRetValue
= objParent.Validate
If
strRetValue <> "" Then
If
IsDataValid(objParent) Then
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntOtherErr)
Else
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntValidateErr)
End
If
strErrMsg
= strErrMsg & " to finish Duplicate action"
DisplayErrMsg
strErrMsg, blnWebClient, sessionObj
strRetValue
= objParent.Revert
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
End
If
exit
sub
Else
strRetValue
= objParent.Commit
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
exit
sub
End If
End
If
oldStrParentState
= strParentState
strParentState
= objParent.GetFieldValue("state").GetValue()
If
blnDebug and Not blnWebClient Then
msgbox
"Original Parent State= " & oldStrParentState
msgbox
"Unduplicate Parent State= " & strParentState
End
If
End If
' Transition
parent to an editable state to link Calls.
' State
Transitioning Error (Error 2):
' A state
transition error will occur if hardcoded state transitions are not defined
' in state transition
matrix.
' Parent
will be in the last state to which it was transitioned.
' User
should finish transitioning parent to an editable state, link calls, and
' transition
parent back to its original state.
Report to System Administrator.
If Not
IsDefectEditable (strParentState) Then
GetActions
strParentState, strActionArray, 1
For
i = LBound(strActionArray) to UBound(strActionArray)
sessionObj.EditEntity
objParent, strActionArray(i) If
err.description <> "" Then
strErrMsg = BuildErrMsg (strErrArray, err.description,
cntTransitionErr)
strErrMsg = strErrMsg & " to finish
Duplicate action"
DisplayErrMsg strErrMsg, blnWebClient,
sessionObj
exit sub
End
If
'
Validate and commit state transition.
'
Invalid Data (Error 1) and Other Errors (Error 3):
'
If Invalid Data is detected or an Other Error occurs, changes will
'
be reverted. Parent will be in the last
state to which it was transitioned.
'
Calls will not be copied.
'
'
If invalid data is detected, user should transition parent to editable state,
fix data on
'
parent record, link calls, and transition parent back to its original
state.
'
If an other error occurs, user should report to the System Administrator.
strRetValue
= objParent.Validate
If
strRetValue <> "" Then
If
IsDataValid(objParent) Then
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntOtherErr)
Else
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntValidateErr)
End
If
strErrMsg
= strErrMsg & " to finish Duplicate action"
DisplayErrMsg
strErrMsg, blnWebClient, sessionObj
strRetValue
= objParent.Revert
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
End
If
exit
sub
Else
strRetValue
= objParent.Commit
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
exit
sub
End
If
End
If
Next
End if
' Link child
Calls to parent.
sessionObj.EditEntity
objParent, "Modify"
If
err.description <> "" Then
strErrMsg
= BuildErrMsg (strErrArray,
err.description, cntOtherErr)
strErrMsg
= strErrMsg & " to finish Duplicate action."
DisplayErrMsg
strErrMsg, blnWebClient, sessionObj
exit
sub
End If
parentRefList
= objParent.GetFieldValue("Customer_link").GetValueAsList()
refList =
GetFieldValue("Customer_link").GetValueAsList()
For i = LBound(refList)
to UBound(refList)
If
objParent.GetFieldValue("Customer_link").GetValueStatus =
AD_HAS_VALUE Then
If
UBound(parentRefList) >= i Then
If
refList(i) <> parentRefList(i) Then
objParent.addFieldValue
"Customer_link", refList(i)
End
If
Else
objParent.addFieldValue
"Customer_link", refList(i)
End If
Else
objParent.addFieldValue
"Customer_link", refList(i)
End
If
next
' Validate and commit link Calls transaction.
'
' Invalid
Data (Error 1) and Other Errors (Error 3):
' If Invalid data is detected or an Other
Error occurs, parent will be in the
' state to
which it was transisitioned. Calls WILL be linked.
' If Invalid
Data detected, user should transition parent to an editable state (if
' not
editable), fix data and transition parent back to its original state.
' Invalid
data includes missing data that's required for a state change.
' For
example,
' A record
that's imported into ClearQuest may be missing data that is
' required
in record in Closed state may be missing the following data
' required
to close a record: component, fix_effort, note_entry, and resolution.
' If the
record is transitioned from Closed to Assigned to copy links, a validation
' error will
occur when the record is transitioned back to Closed if the data is
' missing.
' If an
Other Error occurs, user should report to System Administrator.
strRetValue
= objParent.Validate
If strRetValue
<> "" Then
If
IsDataValid(objParent) Then
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntOtherErr)
Else
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntValidateErr)
End
If
strErrMsg
= strErrMsg & " to finish Duplicate action"
DisplayErrMsg
strErrMsg, blnWebClient, sessionObj
strRetValue
= objParent.Revert
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
End
If
exit
sub
Else
strRetValue
= objParent.Commit
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
exit
sub
End
If
End If
‘ If parent
was not editable, transition back to its original state.
' State
Transitioning Error (Error 2):
' A state
transition error will occur if hardcoded state transitions are not defined
' in state
transition matrix.
' Parent
will be in the last state to which it was transitioned.
' User
should transition parent back to its original state.
If Not
IsDefectEditable (strParentState) Then
GetActions
strParentState, strActionArray, 2
For
i = LBound(strActionArray) to UBound(strActionArray)
sessionObj.EditEntity
objParent, strActionArray(i)
If
err.description <> "" Then
strErrMsg
= BuildErrMsg (strErrArray,
err.description, cntTransitionbackErr)
strErrMsg
= strErrMsg & " to finish Duplicate action"
DisplayErrMsg
strErrMsg, blnWebClient, sessionObj
strRetValue
= objParent.Revert
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
End
If
exit
sub
End
If
'
Validate and commit each state transition.
'
Invalid data error occurs after Calls are linked.
'
Missing data required for the state transition or
'
invalid data (Error 6):
'
Parent will be in the state to which it was last transisitioned.
'
Calls will be linked. User needs to
transition parent to
'
original state.
strRetValue
= objParent.Validate
If
strRetValue <> "" Then
strErrArray(cntPostValidateErr)
= strErrArray(cntPostValidateErr) & NL & "Orignal state: "
& strParentState & NL
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntPostValidateErr)
strErrMsg
= strErrMsg & " to finish Duplicate action." & NL & NL
DisplayErrMsg strErrMsg, blnWebClient, sessionObj
strRetValue
= objParent.Revert
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
End If
exit
sub
Else
strRetValue
= objParent.Commit
If
strRetValue <> "" TheN
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
exit
sub
End
If
End
If
Next
End If
' Mark
parent as a Duplicate.
' Mark as
Duplicate Error (Error 4)
' If an
error occurs, the parent record will be in its
'
unduplicate state. Calls have been
copied.
' The user
should mark the original record as a duplicate.
'
Possible cause of error is parent deleted.
If
oldStrParentState = "Duplicate" Then
sessionObj.MarkEntityAsDuplicate
objParent, objOriginal, "Duplicate"
strRetValue
= objParent.Validate
If
strRetValue <> "" Then
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntDuplicateErr)
strErrMsg
= strErrMsg & " to finish Duplicate action"
DisplayErrMsg
strErrMsg, blnWebClient, sessionObj
objParent.Revert
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
End
If
Else
strRetValue
= objParent.Commit
If
strRetValue <> "" Then
DisplayErrMsg
strRetValue, blnWebClient, sessionObj
End
If
End
If
End If
End If
' Clear session variable
indicating the processing type.
' Note: if an error
occurs, strSessionValue is cleared in DisplayErrMsg.
sessionObj.NameValue
"strSessionValue", ""
End Sub
[8] Function IsDefectEditable (strParentState)
on error resume next
err.clear
Dim
blnIsEditable
blnIsEditable
= True
If
strParentState = "Closed" or strParentState = "Forwarded"
Then
blnIsEditable
= False
End If
IsDefectEditable
= blnIsEditable
End Function
End Sub
[9] Function IsDataValid (objEntity)
on error resume next
err.clear
Dim
fieldobjs
Dim field
Dim isOk
Dim temp
'
GetInvalidFieldValues can only be called when the record is editable.
fieldObjs =
objEntity.GetInvalidFieldValues
For Each
field In fieldObjs
temp
= field.GetValidationStatus
If
temp = AD_KNOWN_INVALID Then
isOk
= False
ElseIf
temp = AD_KNOWN_VALID Then
isOk
= False
ElseIf
temp = AD_NEEDS_VALIDATION Then
isOk
= False
End
If
next
If isOk
Then
IsDataValid
= True
Else
IsDataValid
= False
End if
End Function
[10] Function BuildErrMsg (strErrArray, strErr, cntErrorNumber)
on error
resume next
err.clear
' Purpose: Build a string error
message.
' Inputs: strErrArry Array of
string error messages.
' strErr System generated string error
message.
' cntErrorNumber Error number constant for error message
' in
strErrArray.
' Return: String error message.
' Called: Clone Action, Duplicate Action.
Dim NL
Dim
strErrMsg
NL = vbcrlf
strErrMsg =
strErrArray(cntErrorNumber) & NL & strErr & NL & NL &
"Click OK"
BuildErrMsg
= strErrMsg
End Function
[11] Sub DisplayErrMsg (strMessage, blnWebClient, sessionObj)
on error
resume next
err.clear
' Purpose: Display error message if
Windows client.
' Inputs: strMessage String error
message to display.
' blnWebClient True if Web client. False if not.
'
' Return: None.
' Called: Clone Action, Duplicate Action.
' Don't
display error message to messages control in this sub.
' Only want
to display web messages in hooks before Commit or Notification
' so
message will be saved to database. Web messages need to be saved
' to the
database because Web processing clears the messages control before
' the user
can see an error.
'
If Not
blnWebClient Then
msgbox
strMessage, vbcritical, "Error"
End If
' Clear session variable indicating
type of current processing.
' Must clear this variable so hooks
will
' fire on subsequent defect updates
and deletes.
sessionObj.NameValue
"strSessionValue", ""
' Set
session variable with error message.
' Any
processing in Commit or Notification hooks will
' be skipped if session variable
<> "".
'
sessionObj.NameValue
"sessionErrMsg", strMessage
End Sub
[12] Sub GetActions (strParentState, strActionArray,
intDirection)
on
error resume next
err.clear
' Purpose: Get the actions required to transition a defect to
' an
editable state or to transition back to original state.
'
' Inputs: strParentState state
of parent defect.
' strActionArray Array to contain the actions required to
' transition
the defect to the desired state.
' intDirection An integer representing the
direction to
' transition a
defect.
' 0
= transition defect to strParentState.
' 1
= transition defect from strParentState
' to
an editable state.
' Return: None.
' Called: Clone Action, Duplicate Action.
' Transition parent to an editable
state. (Duplicate action)
If intDirection = 1 Then
If strParentState =
"Closed" Then
ReDim
strActionArray (0)
strActionArray(0)
= "Re_open"
ElseIf strParentState =
"Forwarded" Then
ReDim
strActionArray(0)
strActionArray(0)
= "Resolve"
End If
' Transition child to parent
state. All clones are created in Submit
state so
' these transitions are all from
Submit state.
' (Clone action)
Elseif IntDirection = 0 Then
If strParentState =
"Closed" Then
ReDim
strActionArray (0)
strActionArray(0)
= "Close"
ElseIf strParentState =
"Resolved" Then
ReDim
strActionArray(1)
strActionArray(0)
= "Qualify"
strActionArray(1)
= "Resolve"
ElseIf strParentState =
"Assigned" Then
ReDim
strActionArray (0)
strActionArray(0)
= "Qualify"
ElseIf strParentState =
"Forwarded" Then
ReDim
strActionArray(0)
strActionArray(0)
= "forward"
ElseIf strParentState =
"Qualify" Then
ReDim
strActionArray(0)
strActionArray(0)
= "Reproduce"
ElseIf strparentState =
"Review" Then
ReDim
strActionArray (2)
strActionArray(0)
= "Qualify"
strActionArray(1)
= "Resolve"
strActionArray(2)
= "consult"
Elseif strParentState =
"Can_not_qualify" Then
ReDim
strActionArray (0)
strActionArray(0)
= "Can_not_qualify"
ElseIf strParentState =
"Postponed" Then
ReDim
strActionArray (0)
strActionArray(0)
= "Defer"
End If
' Transition parent back to original
state. (Duplicate action)
Else
If strParentState =
"Closed" Then
ReDim
strActionArray (1)
strActionArray(0)
= "Resolve"
strActionArray(1)
= "Verify"
ElseIf strParentState =
"Forwarded" Then
ReDim
strActionArray(1)
strActionArray(0)
= "Bounce"
strActionArray(1)
= "forward"
End If
End If
End Sub
[13]Sub Defect_Initialization(actionname, actiontype)
'actionname As String
'actiontype As Long
‘action = Reproduce
‘Purpose: Set the assigned date to the current date if the Reproduce action
is applied to the SCR.
SetFieldValue "assign_date",
now()
End Sub
[14] Function Defect_AccessControl(actionname, actiontype,
username)
'actionname As String
'actiontype As Long
'username As String
‘Defect_AccessControl As Boolean
'action = Delete
‘Purpose: Only allow a SCR to be deleted if the current user (username) is
not the submitter or the current user is admin.
DIM session
DIM
submitter
DIM is_ok
is_ok = True
If username
<> "admin" then
submitter =
GetFieldValue("Submitter").GetValue
If submitter
<> username then
is_ok
= False
Else
is_ok
= True
End
if
End if
Defect_AccessControl
= is_ok
End Function
[15]Sub Defect_Initialization(actionname, actiontype)
'actionname
As String
'actiontype As Long
'action = Resolve
‘Purpose: Set the resolution date to the current date if the Resolve action
is applied to the SCR.
SetFieldValue "resolution_date",
now()
End Sub
[16] Function
Defect_Validation(actionname, actiontype)
' actionname As
String
' actiontype As
Long
' Defect_Validation
As String
' action = Bounce
on error resume next
err.clear
Dim blnDebug
Dim
blnWebClient
Dim Currentdbid
Dim
strAssignedTo
Dim strSQL
Dim
strTimeStamp
blnDebug =
True
blnWebClient
= Check_Web()
Set
sessionObj = GetSession
Currentdbid
= GetFieldValue ("dbid").GetValue()
strSQL = "select T1.user_name,
T1.action_timestamp from history T1 where T1.dbid <> 0 and " & _
"new_state = 'Resolved' and
entitydef_name = 'Defect' " & _
"and
action_name = 'Resolve' and entity_dbid = " & clng(Currentdbid) &
" order by T1.action_timestamp desc"
set
resultSetObj = sessionObj.BuildSQLQuery(strSQL)
resultSetObj.Execute
status =
resultSetObj.MoveNext
If blnDebug and Not blnWebClient Then
msgbox
"dbid= " & Currentdbid
msgbox
"strSQL= " & strSQL
msgbox
"status= " & status
End If
If status =
AD_SUCCESS Then
strAssignedTo
= resultSetObj.GetColumnValue(1)
setFieldValue
"AssignedTo", strAssignedTo
If
blnDebug and Not blnWebClient Then
msgbox
strAssignedTo
strTimeStamp
= resultSetObj.GetColumnValue(2)
msgbox
strTimeStamp
End
If
End If
Set
resultSetObj = Nothing
Set
sessionObj = Nothing
End Function
[17] Sub
Defect_Initialization(actionname, actiontype)
'actionname As String
'actiontype As Long
'action = Clone
Dim
parentState
Dim
fieldReq
Dim
fieldnamelist
' Set the
behavior for all fields except ChildPlatforms and platforms
' to
READONLY for states that allow modify action.
parentState
= GetFieldValue("State").GetValue()
If
parentState <> "Closed" and parentState <>
"Review" and parentState <> "Postponed" then
fieldnamelist
= GetFieldNames
For
Each fieldname In fieldnamelist
If
fieldName <> "ChildPlatforms" and fieldName <>
"platform" then
fieldReq
= GetFieldRequiredness(fieldName)
If
fieldReq = AD_OPTIONAL Then
SetFieldRequirednessForCurrentAction
fieldName, AD_READONLY
End
if
End
if
Next
End if
fieldName = "ChildPlatforms"
SetFieldRequirednessForCurrentAction
fieldName, AD_MANDATORY
End Sub
[18] Function Defect_Validation(actionname, actiontype)
'actionname As String
'actiontype As Long
'Defect_Validation As String
'action = Clone
'on error resume next
'err.clear
' Purpose: Clone the
current SCR.
' Cloning is invoked through a Clone Action and is available
' for all
states. The child will be transitioned
to the parent's
'state unless the parent state is
Duplicate.
'
'
' Inputs: Clone Action.
' Returns: None
'
' Fields: None
' Forms: None
'
' Global
Scripts:
'
' Notes:
' Schema
changes:
' 1. Add
the these fields: Child, Children, ParentSCR, ChildPlatforms.
' 2. Add a
Clone Action.
' 3. Set
behaviors for Child, Children,and ParentSCR to ReadOnly. Set ChildPlatforms to Mandatory for the
Clone action.
' 4. Add a
ChoiceList hook to the ChildPlatforms field to create a Product dependent list
of Platforms.
' 5. make
clone action availabe to all states.
Dim attachFields
Dim
blnWebClient
Dim
childDBID
Dim childID
Dim
ChildPlatforms
Dim
fieldName
Dim
fieldType
Dim
fieldValue
Dim
fieldObjs
Dim i
Dim ID
Dim
intAttachField
Dim
objChild
Dim
parentDBID
Dim
parentID
Dim refList
Dim
sessionObj
Dim
strMyRetValue
Dim strRetValue
Dim
TempDiskSpace
Dim tfile
blnWebClient
= Check_Web()
blnDebug = False
' Get the
temporary directory to copy attached files.
tfolder =
GetTemporaryFolder
' Get the
amount of free disk space.
TempDiskSpace
= GetDiskSpace(tfolder)
set
sessionObj = GetSession
' remove after testing
strErrMsg =
"testing for session variables from validation"
DisplayErrorMsg
strErrMsg, blnWebClient, sessionObj
' Get child
platforms from parent.
ChildPlatforms
= GetFieldValue("ChildPlatforms").GetValue()
parentDBID
= GetDBID
parentID =
GetFieldValue("id").GetValue()
set
objChild = sessionObj.BuildEntity("Defect")
childDBID =
objChild.GetDBID
Set
objChild = sessionObj.GetEntityByDbId("Defect", childDBID)
ChildId =
objChild.GetFieldValue("id").GetValue()
set
attachFields = attachmentFields
intattachField
= 0
' Copy
values from parent to child.
fieldObjs =
GetAllFieldValues
For Each field
In fieldObjs
fieldName
= field.GetName
fieldValue
= field.GetValue
fieldType
= field.GetType
If
blnDebug Then
msgbox
"fieldName = " & fieldName
msgbox
"fieldValue = " & fieldValue
msgbox
"fieldType = " & fieldType
End
If
'
Exclude ClearQuest internal fields and parent specific data.
If
fieldName <> "is_active" and fieldName <>
"lock_version" and _
fieldName
<> "locked_by" and fieldName <> "version" and _
fieldName <>
"ChildPlatforms" and _
fieldName
<> "dupl_id" and fieldName <> "platform" and _
fieldName
<> "is_duplicate" and fieldName <>
"unduplicate_state" and _
fieldName
<> "ParentSCR" and
fieldName <> "Children" and _
fieldName
<> "ParentDefect" then
If
fieldType = AD_DBID Then
ElseIf
fieldType = AD_ID Then
ElseIf
fieldType = AD_JOURNAL Then
ElseIf
fieldType = AD_QUESTIONMARK Then
ElseIf
fieldType = AD_STATE Then
ElseIf
fieldType = AD_STATETYPE Then
ElseIf
fieldType = AD_ATTACHMENT_LIST Then
CopyAttachments
objChild, attachFields, intattachField, TempDiskSpace, tfile
intattachField
= intattachField + 1
ElseIf
fieldType = AD_REFERENCE_LIST Then
refList
= GetFieldValue(fieldName).GetValueAsList()
If
GetFieldValue(fieldName).GetValueStatus = AD_HAS_VALUE Then
For
i = LBound(refList) to UBound(refList)
objChild.addFieldValue
fieldName, refList(i)
next
End
If
Else
objChild.SetFieldValue
fieldName, fieldValue
If
err.description <> "" Then
msgbox
err.description
End
If
End
if
End
if
Next
'objChild.SetFieldvalue
"Component", GetFieldValue("Component").GetValue()
objChild.setFieldValue
"platform", ChildPlatforms
objChild.setFieldValue
"ParentSCR", ParentID
' Validate
and commit child.
' Since the
Clone action is a modify action, the parent data is validated
' before
the Clone action is invoked. Therefore, it is unlikely that a
' data
validation originating from the parent will occur.
strRetValue
= objChild.Validate
If
strRetValue <> "" Then
strMyRetValue
= BuildValidateErrMsg (objChild)
strErrMsg
= BuildErrMsg (strErrArray, strMyRetValue, cntValidateErr)
DisplayErrorMsg strErrMsg, blnWebClient
strRetValue
= objChild.Revert
If
strRetValue <> "" Then
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntTransitionErr)
DisplayErrorMsg
strErrMsg, blnWebClient, sessionObj
End
If
Else
strRetValue
= objChild.Commit
If
strRetValue <> "" Then
DisplayErrorMsg
strErrMsg, blnWebClient, sessionObj
Else
' Update these fields on the parent.
setFieldValue
"Child", ChildID
addFieldValue
"Children", ChildID
setFieldValue
"ChildPlatforms", ""
End
If
End If
End Function
[19] Sub Defect_Notification(actionname, actiontype)
‘ationname As String
'actiontype As Long
'action = Clone
'on error resume next
'err.clear
Const
cntValidateErr = 0
Const
cntIntegrityErr = 1
Const
cntTransitionErr = 2
Dim
strActionArray()
Dim i
Dim
strErrMsg
Dim
strRetValue
Dim strParentState
Dim
strChildState
Dim
sessionObj
Dim
objChild
Dim
blnDebug
Dim NL
Dim
strErrArray (2)
Dim
blnWebClient
Dim
sessionErrMsgValue
NL = vbcrlf
blnDebug =
True
blnWebClient
= Check_Web()
strErrArray(cntValidateErr)
= "A data validation error was detected in original record." & NL
strErrArray(cntValidateErr)
= strErrArray(cntValidateErr) & "Calls have not been linked. Correct
data and manually link Calls." & NL
strErrArray(cntIntegrityErr)
= "An error has occurred. Check
data integrity of original SCR." & NL
strErrArray(cntIntegrityErr)
= strErrArray(cntIntegrityErr) & "Original SCR = " & vbtab
& vbtab & strParentID & NL
strErrArray(cntIntegrityErr)
= strErrArray(cntIntegrityErr) & "Original State" & vbtab
& "= " & parentState
strErrArray(cntTransitionErr)
= "Possibly invalid state transition."
Set
sessionObj = GetSession
If
sessionObj.HasValue ("sessionErrMsg") Then
msgbox "session test from notification
"
sessionErrMsgValue
= sessionObj.NameValue("sessionErrMsg")
msgbox
"session error message Value = " & sessionErrMsgValue
setFieldValue
"messages", sessionErrMsgValue
sessionObj.NameValue
"sessionStrErrMsg", ""
exit
sub
End If
strParentState
= GetFieldValue("State").GetValue()
' make
global
ChildId =
GetFieldValue("child").GetValue()
If blnDebug
Then msgbox "Child ID = " & ChildID
If blnDebug
Then
msgbox
"Parent State = " & strParentState
End If
If
strParentState <> "Submitted" Then
set
objChild = sessionObj.GetEntity("Defect", ChildId)
GetActions
strParentState, strActionArray, 1
For
i = LBound(strActionArray) to UBound(strActionArray)
sessionObj.EditEntity
objChild, strActionArray(i)
If
err.description <> "" Then
strErrMsg
= BuildErrMsg (strErrArray,
err.description, cntTransitionErr)
DisplayErrorMsg
strErrMsg, blnWebClient, sessionObj
exit
sub
End
If
'
Validate and commit each state transition.
strRetValue
= objChild.Validate
If
strRetValue <> "" Then
strMyRetValue
= BuildValidateErrMsg (objChild)
strErrMsg
= BuildErrMsg (strErrArray, strMyRetValue, cntValidateErr)
DisplayErrorMsg strErrMsg, blnWebClient
strRetValue
= objChild.Revert
If
strRetValue <> "" Then
strErrMsg
= BuildErrMsg (strErrArray, strRetValue, cntTransitionErr)
DisplayErrorMsg
strErrMsg, blnWebClient, sessionObj
End
If
Else
strRetValue
= objChild.Commit
If
strRetValue <> "" Then
DisplayErrorMsg
strErrMsg, blnWebClient, sessionObj
End
If
End
If
Next
End If
If
sessionObj.HasValue ("sessionErrMsg") Then
sessionErrMsgValue
= sessionObj.NameValue("sessionErrMsg")
msgbox
sessionErrMsgValue
setFieldValue
"messages", sessionErrMsgValue
sessionObj.NameValue
"sessionStrErrMsg", ""
'clear
session error
End If
End Sub
[20] function GetDiskSpace (tfolder)
Dim fso, d, s
Dim drvPath
drvPath = Left(tfolder,3)
Set fso = CreateObject("Scripting.FileSystemObject")
Set d =
fso.GetDrive(fso.GetDriveName(drvPath))
s = "Drive " &
UCase(drvPath) & " - "
s = s & d.VolumeName & "<BR>"
s = s & "Available Space:
" & FormatNumber(d.AvailableSpace/1024, 0)
s = s & " Kbytes"
GetDiskSpace = s
End Function
[21] Function GetTemporaryFolder
Dim fso, f,
tfolder
Set fso =
CreateObject("Scripting.FileSystemObject")
Const TemporaryFolder = 2
Set tfolder =
fso.GetSpecialFolder(TemporaryFolder)
GetTemporaryFolder
= tfolder
End Function
[22] Sub AssignedTo_ValueChanged(fieldname)
' fieldname As String
‘
'Purpose:
Default Assign Date to the current date when the Assigned To is changed.
SetFieldValue "assign_date",
now()
End Sub
[23] Sub Customer_link_ValueChanged(fieldname)
'fieldname As String
‘Purpose: Maintain a flag to indicate
whether a Customer is linked to a SCR.
‘The field is used by reports that need
to list SCRs reported by Customers.
‘This processing is required since
outer joins are not supported in Release 1.1.
‘Schema Changes/Notes:
‘1. Add a field called
CustomerReported.
‘2. Add a ValueChanged hook to the
Customer_link field.
‘This code
should be replaced by an outer join they are made available in a future
ClearQuest release.
Dim CustomerLinkValue
Dim IsCustomerReported
CustomerLinkValue =
GetFieldValue(fieldname).GetValue()
If IsNull(CustomerLinkValue) or
(CustomerLinkValue = "") then
IsCustomerReported
= 0
Else
IsCustomerReported
= 1
End if
SetFieldValue
"CustomerReported", IsCustomerReported
End Sub
[24]Sub Component_ChoiceList(fieldname, choices)
‘fieldname As String
'choices As Object
'entityDef = Defect
Dim rsltset
Dim product
Dim status
Dim name
'Purpose: Create a list of Components
that are dependent on Product.
‘Schema Changes/Comments:
‘The Hook Properties, Recalculate
Choice List and Limit to List, need to be marked.
Set Session = GetSession
product =
GetFieldValue("Product").GetValue()
If product = "" or
IsNull(product) then
choices.AddItem("Enter
a Product!")
Else
Set queryDef =
session.BuildQuery("Components")
QueryDef.BuildField("compname")
Set Operator =
querydef.BuildFilterOperator(AD_BOOL_OP_AND)
operator.BuildFilter
"prodname", AD_COMP_OP_EQ, product
Set
rsltset = session.BuildResultSet(queryDef)
rsltset.Execute
status
= rsltset.MoveNext
Do
While status = AD_SUCCESS
name
= rsltset.GetColumnValue(1)
choices.AddItem(name)
status =
rsltset.MoveNext
Loop
choices.Sort
End if
End Sub
[25] Sub old_id_DefaultValue(fieldname)
'fieldname As String
'entityDef = Defect
On Error resume next
err.clear
'Purpose: Default old_id to the id when
a SCR is submitted. The old_id
is
'needed to "fix" data using
the ClearQuest import tool.
Dim id
If
GetFieldValue("id").GetValueStatus = AD_HAS_VALUE Then
id
= GetFieldValue("id").GetValue()
SetFieldValue
fieldname, id
End if
End Sub
[26]Sub planned_fix_version_ChoiceList(fieldname, choices)
'fieldname As String
'choices As Object
'entityDef = Defect
‘Purpose: Create a list of Product versions that are dependent on the
Product.
‘Schema Changes/Notes
‘The Hook Properties, Recalculate
Choice List and Limit to List, need to be marked.
Dim rsltset
Dim product
Dim status
Dim name
Set Session
= GetSession
product =
GetFieldValue("Product").GetValue()
If product = "" or
IsNull(product) then
choices.AddItem("Enter
a Product!")
Else
Set
queryDef = session.BuildQuery("ProductVersion")
QueryDef.BuildField("ProductVersion")
Set
Operator = querydef.BuildFilterOperator(AD_BOOL_OP_AND)
operator.BuildFilter
"prodname", AD_COMP_OP_EQ, product
Set
rsltset = session.BuildResultSet(queryDef)
rsltset.Execute
status
= rsltset.MoveNext
Do
While status = AD_SUCCESS
name
= rsltset.GetColumnValue(1)
choices.AddItem(name)
status
= rsltset.MoveNext
Loop
choices.Sort
End if
End Sub
[27] Sub platform_ChoiceList(fieldname, choices)
'fieldname As String
'choices As Object
'entityDef = Defect
‘Purpose: Create a list of Platforms that are dependent on the Product.
‘Schema Changes/Notes:
‘The Hook Properties, Recalculate Choice
List and Limit to List, need to be marked.
‘A bug exists in the Limit
to List property for List Box controls.
‘If the property is set,
only one item may be added to the list. The ClearQuest Case ID is
Dim rsltset
Dim product
Dim status
Dim name
Set Session
= GetSession
product =
GetFieldValue("Product").GetValue()
If product
= "" or IsNull(product) then
choices.AddItem("Enter
a Product!")
Else
Set
queryDef = session.BuildQuery("Platform")
QueryDef.BuildField("platname")
Set
Operator = querydef.BuildFilterOperator(AD_BOOL_OP_AND)
operator.BuildFilter
"prodname", AD_COMP_OP_EQ, product
Set
rsltset = session.BuildResultSet(queryDef)
rsltset.Execute
status =
rsltset.MoveNext
Do While
status = AD_SUCCESS
name
= rsltset.GetColumnValue(1)
choices.AddItem(name)
status
= rsltset.MoveNext
Loop
choices.Sort
End if
End Sub
[28]Sub Product_ValueChanged(fieldname)
'fieldname As String
‘Purpose: Clear platform, Component,
and Prodvers whenever the Product value changes.
SetFieldValue "platform",
""
SetFieldValue "Component",
""
SetFieldValue "Prodvers",
""
End Sub
[29] Sub rptd_platform_ValueChanged(fieldname)
' Purpose:
' Copy the
value in rptd_platform to platform whenever the value in
'
rptd_platform changes and the SCR state is submitted.
'
'Schema
Changes/Notes:
'Change the
behavior on platform from MANDATORY to READONLY.
Dim state
Dim
platform
state =
GetFieldValue("state").GetValue()
If state = "Submitted" then
platform
= GetFieldValue(fieldname).GetValue()
setFieldValue
"platform", platform
End if
End Sub
[30]Sub Prodvers_ChoiceList(fieldname, choices)
'fieldname As String
‘choices As Object
'entityDef = Defect
‘Purpose: Create a list of Product Versions that are dependent on the
Product.
‘Schema Changes/Notes:
‘The Hook Properties, Recalculate
Choice List and Limit to List, need to be marked.
Dim rsltset
Dim product
Dim status
Dim name
Set Session
= GetSession
product =
GetFieldValue("Product").GetValue()
If product
= "" or IsNull(product) then
choices.AddItem("Enter
a Product!")
Else
Set
queryDef = session.BuildQuery("ProductVersion")
QueryDef.BuildField("ProductVersion")
Set
Operator = querydef.BuildFilterOperator(AD_BOOL_OP_AND)
operator.BuildFilter
"prodname", AD_COMP_OP_EQ, product
Set
rsltset = session.BuildResultSet(queryDef)
rsltset.Execute
status
= rsltset.MoveNext
Do
While status = AD_SUCCESS
name
= rsltset.GetColumnValue(1)
choices.AddItem(name)
status
= rsltset.MoveNext
Loop
choices.Sort
End if
End Sub
[31] Sub
SCRtype_ValueChanged(fieldname)
Dim SCRType
'Purpose:
'When a new
SCR is submitted, set platform mandatory only if
'type is
not an enhancement.
'Schema
Changes/Notes:
'Set the
Submit behavior for SCRType to OPTIONAL.
SCRType =
GetFieldValue("SCRtype").GetValue()
If
SCRType <>
"Enhancement" then
SetFieldRequirednessForCurrentAction
"platform", AD_MANDATORY
Else
SetFieldRequirednessForCurrentAction
"platform", AD_OPTIONAL
End if
End Sub
[32]Sub Submit_Date_DefaultValue(fieldname)
'fieldname As String
'entityDef = Defect
‘Purpose: Default Submit Date to the current date when a SCR is submitted.
SetFieldValue fieldname, Now()
End Sub
[33]Sub Submitter_DefaultValue(fieldname)
‘fieldname As String
'entityDef = Defect
'Purpose:
Default Submitter to the current user logon id when a SCR is submitted.
DIM session
DIM username
set session = GetSession
username = session.GetUserLoginName
SetFieldValue fieldname, username
End Sub
[34]Sub version_fixed_ChoiceList(fieldname, choices)
‘fieldname As String
'choices As Object
'entityDef = Defect
‘Purpose: Create a list of Product versions that are dependent on Product.
‘Schema Changes/Notes
‘The Hook Properties, Recalculate
Choice List and Limit to List, need to be marked.
Dim rsltset
Dim product
Dim status
Dim name
Set Session
= GetSession
product =
GetFieldValue("Product").GetValue()
If product = "" or
IsNull(product) then
choices.AddItem("Enter
a Product!")
Else
Set
queryDef = session.BuildQuery("ProductVersion")
QueryDef.BuildField("ProductVersion")
Set
Operator = querydef.BuildFilterOperator(AD_BOOL_OP_AND)
operator.BuildFilter
"prodname", AD_COMP_OP_EQ, product
Set
rsltset = session.BuildResultSet(queryDef)
rsltset.Execute
status =
rsltset.MoveNext
Do While
status = AD_SUCCESS
name
= rsltset.GetColumnValue(1)
choices.AddItem(name)
status
= rsltset.MoveNext
Loop
choices.Sort
End if
End Sub
