采用下面这段代码希望在CQ中创建一个BaseCMActivity(添加了其他包).

需要说明的是 在UI上 选择了Project字段(该字段是个引用字段,被引用的Project为一个无状态类型)的值后， NextVersion,Owner这两个字段的ChoiceList会重新计算更新,其更新时机是在Project字段的VALUE_CHANGED Hook里面完成.

通过UI能够创建BaseCMActivity。但通过下面的代码，则提示如下错误：

E:\PerlWorkspace>cqperl createCQRecord.pl
the id is Prod00000021
6
Execution of a hook failed during the action Submit.  It was the FIELD_VALUE_CHA
NGED hook of the field Project, attached to the BaseCMActivity "Prod00000021".
The reason for the failure was:
Failed condition: ent != 0
Location: ClearQuest Core:adreferencefield.cpp:75 at C:/Program Files/Rational/C
ommon/lib/perl5/site_perl/5.6.1/CQPerlExt.pm line 1515.

——————————————————————————————————————————————————————————————————————————————

use strict;
use CQPerlExt;

my $user = "admin";
my $pawd = "XXX";
my $dbName = "Prod";
my $dbSet = "SR1";

my $project = "XXX";
my $attachmentfile = "E:\PerlWorkspace\hello.pl";
#my $filename =~ s/(.*\\)(.*)/$1/;
my $headline = "发布包 filename  到 $project 项目的SIT环境";
my $description = "OK";
my $nextVersion = "XXXXXXXX";

my $entityType = "BaseCMActivity";
my $filedValue = [
        ["Headline",$headline],
        ["Project",$project],
        ["Owner","admin"],
        ["Description",$description],
        ["Type","Others"],
        ["NextVersion",$nextVersion],
];


#=========================================================================

my $currentSession = CQSession::Build();

$currentSession->UserLogon( $user, $pawd, $dbName, $dbSet );

my $currentEntity = $currentSession->BuildEntity($entityType);       

my $displayname = $currentEntity->GetDisplayName();
print "the id is $displayname\n";

my $filedSize = @{$filedValue};
print $filedSize ,"\n";

for (my $x = 0; $x < $filedSize ; $x++){

  $currentEntity->SetFieldValue($filedValue->[$x][0],$filedValue->[$x][1]);

}

my $attachfields = $currentEntity->GetAttachmentFields();
my $numfields = $attachfields->Count();

for (my $x = 0; $x < $numfields ; $x++)
{

  my $onefield = $attachfields->Item($x);
  print $onefield->GetFieldName(), "\n";
  my $attachments = $onefield->GetAttachments();

  if (!$attachments->AddAttachment($attachmentfile ,"attachment description"))
  {
     $currentSession ->OutputDebugString("Error adding attachment to record.\n");
  }
}


my $status = $currentEntity->Validate();

if ($status == ""){
  
  $status = $currentEntity->Commit();
}
else {
       
        print "status\n";
  $currentEntity->Revert();
}

CQSession::Unbuild($currentSession);

先试试用手工提交一条完全相同的记录，看是否能成功。

错误的原因可能是owner和nextversion的值是非法的，这个应该是设置projecct值时导致的。

手工创建是可以的。而且设置的owner, nextversion的值也是 合法的。

Hook代码是用Basic 写的。是否因为这个外部 程序 使用Perl调用 CQ API，获得  Session不能为Hook 的Basic代码（该Hook还调用了一个Basic写的全局脚本）所用造成的呢？

确实是因为 Perl 调用的CQ API代码 创建的Session对象不能 为 Basic Hook所用导致。

该脚本，用VBS重写(包括用perl调用的引子) 如下：

Prompt: cqperl invokeCreateBaseCMActivityVBS.pl

-----------------------------------------------------------------------------------------
#invokeCreateBaseCMActivityVBS.pl
use strict;

my $project = "GEL_China";
my $nextVersion = "GELC_V2.19.006";
my $attachmentAddr = "E:\\PerlWorkspace\\hello.pl";
my $desc = "Ok";

my $result = `cscript.exe createCQRecord.vbs $project $nextVersion $attachmentAddr $desc`;
my $fresult = "print by perl:";
print "$fresult";
print $result;


-----------------------------------------------------------------------------------------
REM createCQRecord.vbs
Set objArgs = WScript.Arguments

Rem For I = 0 To objArgs.Count - 1  
Rem    WScript.Echo objArgs(I)
Rem Next

project = objArgs(0)
nextVersion = objArgs(1)
attachmentAddr = objArgs(2)
desc = objArgs(3)

username = "admin"
password = "XXX"
dbname = "Prod"
dbset = "SR1"

entityType = "BaseCMActivity"
headline = "test"
Rem project = "XXX"
owner = "admin"
Rem nextVersion = "XXX"
activityType = "Others"
Rem desc = "OK"
Rem attachmentAddr = "E:\PerlWorkspace\hello.pl"

Set session = CreateObject("CLEARQUEST.SESSION")
session.UserLogon username, password, dbname, AD_PRIVATE_SESSION, dbset

Set entityObj = session.BuildEntity(entityType)
entityObj.SetFieldValue "Headline", headline
entityObj.SetFieldValue "Project",project
entityObj.SetFieldValue "Owner",owner
entityObj.SetFieldValue "NextVersion",nextVersion
entityObj.SetFieldValue "ActivityType",activityType
entityObj.SetFieldValue "Description",desc

Set fields = entityObj.AttachmentFields
For Each fieldObj in fields
  set attachments = fieldObj.Attachments
  If Not attachments.Add(attachmentAddr, "") Then
    OutputDebugString "Error adding attachment to record."
  End If
  next

status = entityObj.Validate

displayName = entityObj.GetDisplayName

If status = "" then
status = entityObj.Commit
  If status = "" then
    Rem successful commit
  else
    Rem check error message
  end If
else
  entityObj.Revert
  MsgBox "Revert! " & status
end If
  Rem The Entity object is no longer editable
  
Rem WScript.Echo "print by vbs: " & displayName
WScript.StdOut.WriteLine "print by vbs: " & displayName

[ 本帖最后由 SilenceCliff 于 2008-4-30 17:16 编辑 ]