problem with perl script transfered from VB script

problem with perl script transfered from VB script

am 06.08.2008 14:08:54 von Xiao Yafeng

I've transfered some VB script that insert some data into Oracle by
DCOM component into perl by VB script converter. Below is the code:


Please note $rs is ADO recordset!!!!!
vb script:

Option Explicit
Const cnNoFlags = 0
Const cnNoCheckpoint = -1
Dim ctMgr 'Container Manager
Dim aeMgr 'Active Element Manager
Dim aeTMgr 'Active Element Template Manager
Dim aSec 'Athena Security Token
Dim mdi 'Meter Data Interface
Dim nContractContainerID 'Internal ID of contract
Dim nMeterProxyID 'Internal ID of new meter proxy
'Initialisation of object instances
Set mdi = CreateObject("DeviceAndMeterdata.ADASDeviceAndMeterdata.1")
Set ctMgr = CreateObject( "Athena.CT.ContainerManager.1" )
Set aeMgr = CreateObject("Athena.CT.ActiveElementManager.1")
Set aeTMgr = CreateObject("Athena.CT.ActiveElementTemplateManager.1")
Set aSec = CreateObject( "AthenaSecurity.UserSessions.1" )
aSec.ConvergeLogin "Administrator", "Athena", 0, 666
'--- Main code -------------------------------------------------------
+------------------------
nContractContainerID = GetContainerID( Array( Array( "contract_number"
+, "MyTestContract01" )))
nMeterProxyID = CreateMeterProxy( nContractContainerID, "Mp_Default",
+"MyTestMeterProxy02", _
GetDeviceID( "+SimMeter004" ) )
WScript.Echo "Meter proxy created having the ID: " & nMeterProxyID
WScript.Echo "Script Finished"
'----------------------------------------------------------- ----------
+------------------------
Function GetContainerID( ByVal paCriteria )
Dim rs
Set rs = ctMgr.Search( Array( "ContainerID" ), paCriteria, Empty, _
cnNoFlags, cnNoCheckPoint, aSec )
GetContainerID = rs.Fields( "ContainerID" )
End Function
'----------------------------------------------------------- ----------
+------------------------
Function GetDeviceID( ByVal psDeviceName )
Dim resultset
Set resultset = mdi.FindDevice(Array( "ADAS_DEVICE" ), _
Array( Array( "ADAS_DEVICE_NAME", psDeviceName ) ), _
Empty, cnNoFlags )
GetDeviceID = resultset.Fields( "ADAS_DEVICE" )
End Function
'----------------------------------------------------------- ----------
+------------------------
Function CreateMeterProxy( ByVal pnContainerID, ByVal psTemplate, ByVa
+l psProxyName, _
ByVal pnDeviceID )
Dim rs
Dim nTemplateID
Dim nCheckoutID, nProxID
nProxID = -1
Set rs = aeTMgr.Search( Array( "AETemplateID" ), _
Array( Array( "AETemplateName", psTemplate ) ), _
Empty, cnNoFlags, cnNoCheckPoint, aSec )
If Not rs.EOF Then
nTemplateID = rs.Fields( "AETemplateID" )
Set rs = aeTMgr.GetValues( nTemplateID, Array( "AEName", "ADAS_ID" ),
+_
cnNoFlags, cnNoCheckPoint, aSec )
rs.Fields( "AEName" ) = psProxyName
rs.Fields( "ADAS_ID" ) = pnDeviceID
nCheckoutID = ctMgr.Checkout( pnContainerID, aSec )
nProxID = aeMgr.CreateActiveElement( nTemplateID, nCheckoutID, rs, aSe
+c )
ctMgr.Checkin nCheckoutID, aSec
End If
CreateMeterProxy = nProxID
End Function


perl script:

#!perl

use Win32::OLE;

use strict;
use constant cnNoFlags => 0;
use constant cnNoCheckpoint => -1;
#my $Empty;
my $ctMgr;
# Container Manager
my $aeMgr;
# Active Element Manager
my $aeTMgr;
# Active Element Template Manager
my $aSec;
# Athena Security Token
my $mdi;
# Meter Data Interface
my $nContractContainerID;
# Internal ID of contract
my $nMeterProxyID;
# Internal ID of new meter proxy
# Initialisation of object instances
$mdi = Win32::OLE->new('DeviceAndMeterdata.ADASDeviceAndMeterdata.1 ');
$ctMgr = Win32::OLE->new('Athena.CT.ContainerManager.1');
$aeMgr = Win32::OLE->new('Athena.CT.ActiveElementManager.1');
$aeTMgr = Win32::OLE->new('Athena.CT.ActiveElementTemplateManager.1');
$aSec = Win32::OLE->new('AthenaSecurity.UserSessions.1');
$aSec->ConvergeLogin('Administrator', 'Athena', 0, 666);
# --- Main code ------------------------------------------------------
+-------------------------
$nContractContainerID = GetContainerID([['contract_number', 'MyTestCon
+tract01']]);
$nMeterProxyID = CreateMeterProxy($nContractContainerID, 'Mp_Default',
+ 'MyTestMeterProxy01', GetDeviceID('+SimMeter001'));
print 'Meter proxy created having the ID: ' . $nMeterProxyID, "\n";
print "Script Finished\n";
# ------------------------------------------------------------ --------
+-------------------------
sub GetContainerID {
my($paCriteria) = @_;
my $rs;
$rs = $ctMgr->Search(['ContainerID'], $paCriteria, $Empty, cnNoFla
+gs, cnNoCheckpoint, $aSec);
return $rs->Fields('ContainerID');
}
# ------------------------------------------------------------ --------
+-------------------------
sub GetDeviceID {
my($psDeviceName) = @_;
my $resultset;
$resultset = $mdi->FindDevice(['ADAS_DEVICE'], [['ADAS_DEVICE_NAME
+', $psDeviceName]], $Empty, cnNoFlags);
return $resultset->Fields('ADAS_DEVICE');
}
# ------------------------------------------------------------ --------
+-------------------------
sub CreateMeterProxy {
my($pnContainerID, $psTemplate, $psProxyName, $pnDeviceID) = @_;
my $rs;
my $nTemplateID;
my ($nCheckoutID, $nProxID);
$nProxID = -1;
$rs = $aeTMgr->Search(['AETemplateID'], [['AETemplateName', $psTem
+plate]], $Empty, cnNoFlags, cnNoCheckpoint, $aSec);
if (!$rs->EOF) {
$nTemplateID = $rs->Fields('AETemplateID');
$rs = $aeTMgr->GetValues($nTemplateID, ['AEName', 'ADAS_ID'],
+cnNoFlags, cnNoCheckpoint, $aSec);
$rs->Fields('AEName') = $psProxyName; #Here is line 60!!!
$rs->Fields('ADAS_ID') = $pnDeviceID;
$nCheckoutID = $ctMgr->Checkout($pnContainerID, $aSec);
$nProxID = $aeMgr->CreateActiveElement($nTemplateID, $nCheckou
+tID, $rs, $aSec);
$ctMgr->Checkin($nCheckoutID, $aSec);
}
return $nProxID;
}
[download]

when I run perl -c, it tossed:
Global symbol "$Empty" requires explicit package name at CMP2.pl line
+39.
Global symbol "$Empty" requires explicit package name at CMP2.pl line
+46.
Global symbol "$Empty" requires explicit package name at CMP2.pl line
+56.
Execution of CMP2.pl aborted due to compilation errors.
[download]
I add 'my $Empty;" in the snippet, and run it again. After several
seconds,it toss:
Can't call method "Fields" on an undefined value at CMP2.pl line 60.
[download]
I notice that $rs->Fields('AETemplateID') return a Win32::OLE hash,
but as GetValues function definition supplier provided:

Definition
GetValues( [in] long TemplateID,
[in] VARIANT* DesiredCharacteristics,
[in] long search_flags,
[in] long checkpoint,
[in] IDispatch* security_token,
[out, retval] IDispatch** recordSet)
TemplateID Internal ID of existing container template
DesiredCharacteristics 1d array of container specific attributes
search_flags Search flags
checkpoint Not implemented
security_token Valid Converge security token
recordSet ADO Recordset containing the values defined in "DesiredChara
+cteristics"
[download]

I suspect in type is wrong. for this reason,I change
$nTemplateID = $rs->Fields('AETemplateID');

to
$nTemplateID = $rs->Fields('AETemplateID')->value;


run the snippet thirdly, It seems process a little:
Can't modify non-lvalue subroutine call at CMP2.pl line 60.
_______________________________________________
ActivePerl mailing list
ActivePerl@listserv.ActiveState.com
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs