IBM®
Skip to main content
    Country/region [select]      Terms of use
 
 
    
     Home      Products      Services & solutions      Support & downloads      My account     
 
developerworks > My developerWorks >  Dashboard > Configuration Management > ... > ClearQuest > 1.5.1.1.8. Validation (Perl)
developerWorks
Log In   View a printable version of the current page.
Overview Connect Spaces Forums Wikis
1.5.1.1.8. Validation (Perl)
Added by bobdorenfeld, last edited by bobdorenfeld on Mar 26, 2009
Labels: 
(None)

Introduction

These are Validation Hooks for Perl code.

Content

Validate Sub Tasks

ValidateSubTasks.pl              Contributed by Leesa Hicks

sub ValidateSubtasks {
    my $result = "" ;
    my $entityActionType ;
    my $entityActionName ;
    my $state;
    my $resultHdr ;
    my $queryDef;
    my $filterNode1;
    my $resultSet;
    my $subTaskList ;
    my $subTaskState;
    my $entityDefName;
    my $fullProductVersion;
    my $VRMF;
    my $interimFix;
    my ($version, $releaseNbr, $modNbr, $fixPack) ;
    my $contextAttribsAvail;
    my $origHookSeesAllUsers;
    my $origHookSeesAllRecords;

    # Verifies that a change request with subtasks cannot be Resolved if
        # any of its subtasks are not all Resolved or Closed.  Similarly,
    # a change request cannot be Closed if any of its subtasks are not all
    # Closed.

    # Get database information from the current session
    my $dbDescObj = $session->GetSessionDatabase();
    my $dbName = $dbDescObj->GetDatabaseName();
    my $dbSetName = $dbDescObj->GetDatabaseSetName();

    # Determine whether the hook visibility attributes are available based
    # on the client version that is running.  These attributes were
    # added in 7.0.0.1-iFix04 and 7.0.1-iFix01, and the first client
    # we have deployed with those capabilities is 7.0.1.1
    $fullProductVersion = $session->GetProductInfo()->GetFullProductVersion();
    ($VRMF, $interimFix) = split (/-/, $fullProductVersion);
    ($version, $releaseNbr, $modNbr, $fixPack) = split(/\./, $VRMF);
    if (    ($version >= 7)
          && ($relNbr >= 0)
         && ($modNbr >= 1)
         && ($fixPack >= 1)
        ) {
        $session->OutputDebugMessage("--> Client is running at least 7.0.1.1\n");
        $contextAttribsAvail = 1;
    }
   

    # If the hook context attributes are available, save them off and set
    # them to make all users and all records visible
    if ($contextAttribsAvail) {
        $origHookSeesAllUsers = $session->GetHookSeesAllUsers();
        $origHookSeesAllRecords = $session->GetHookSeesAllRecords();
        $session->SetHookSeesAllUsers(1);
        $session->SetHookSeesAllRecords(1);
    }

    # If this request has no subtasks, then no further checking is needed
    if ($entity->GetFieldValue("SubTasks")->GetValueStatus() != $CQPerlExt::CQ_HAS_VALUE) {
        RestoreContextAttribs($contextAttribsAvail, $origHookSeesAllUsers, $origHookSeesAllRecords);
        return $result;
    }

    $entityActionType = $entity->GetActionType();
    $entityActionName = $entity->GetActionName();
    $entityDefName = $entity->GetEntityDefName();
    $state = $entity->GetFieldStringValue("State");

    # Check only records that are being modified in the Resolved or
    # Closed state, or are changing state to Resolved or Closed
    if ( ! (    (   $entityActionType == $CQPerlExt::CQ_CHANGE_STATE
                  || ($entityActionType == $CQPerlExt::CQ_MODIFY
                )
             && ( ($state eq "Resolved") || $state eq "Closed"))
           )
       ) {
        RestoreContextAttribs($contextAttribsAvail, $origHookSeesAllUsers, $origHookSeesAllRecords);
           return $result;
    }

    # Build the appropriate error message header
    # in case it is needed
    $resultHdr = "Unable to " . $entityActionName . " this " ;
    if ( $entityActionType == $CQPerlExt::CQ_MODIFY ) {
        $resultHdr = $resultHdr . $state . " ";
    }
    $resultHdr = $resultHdr . $entityDefName . " because:\n";

    # Run a query to obtain the State for each SubTask
    $subTaskList = $entity->GetFieldStringValueAsList("SubTasks");
    $queryDef = $session->BuildQuery($entityDefName);
    $queryDef->BuildField("id");
    $queryDef->BuildField("State");
    $filterNode1 = $queryDef->BuildFilterOperator($CQPerlExt::CQ_BOOL_OP_AND);
    $filterNode1->BuildFilter("id", $CQPerlExt::CQ_COMP_OP_EQ, $subTaskList);
    $resultSet = $session->BuildResultSet($queryDef);
    $resultSet->Execute();
   
    # Determine whether any subtasks are in incomplete states
    # relative to their parent
    my $status = $resultSet->MoveNext();
    while ($status == $CQPerlExt::CQ_SUCCESS) {
       $session->OutputDebugMessage ("-->  ID:  " . $resultSet->GetColumnValue(1) . "\n");
        $subTaskState = $resultSet->GetColumnValue(2) ;

        # If trying to Resolve or modify a Resolved request, make
        # sure this SubTask is either Closed or Resolved
        if (    $state eq "Resolved"
             && ! ($subTaskState eq "Resolved" || $subTaskState eq "Closed" )
           ) {
            if ($result eq "") {
                $result = $resultHdr ;
            }
            $result = $result . "  Subtask " . $resultSet->GetColumnValue(1) . " is not Resolved or Closed\n";
        }

        # If trying to Close or modify a Closed request, make
        # sure this SubTask is either Closed or Resolved
        if (    $state eq "Closed"
             && $subTaskState ne "Closed"
           ) {
            if ($result eq "") {
                $result = $resultHdr ;
            }
            $result = $result . "  Subtask " . $resultSet->GetColumnValue(1) . " is not Closed\n";
        }
                       
        $status = $resultSet->MoveNext();
    }

    RestoreContextAttribs($contextAttribsAvail, $origHookSeesAllUsers, $origHookSeesAllRecords);
    return $result;
}


sub RestoreContextAttribs {
    my ($contextAttribsAvail, $hookSeesAllUsers, $hookSeesAllRecords) = @_;

    # Restore the schema context attributes if they are available
    if ($contextAttribsAvail) {
        $session->SetHookSeesAllUsers($hookSeesAllUsers);
        $session->SetHookSeesAllRecords($hookSeesAllRecords);
       
    }

}

Subsection 2

Put text for subsection 2 here.

See also

  • Put interesting links here


 
    About IBM Privacy Contact