1############################################################################# 2# Software Testing Automation Framework (STAF) # 3# (C) Copyright IBM Corp. 2002 # 4# # 5# This software is licensed under the Eclipse Public License (EPL) V1.0. # 6############################################################################# 7 8use PLSTAF; 9use STAFMon; 10use STAFLog; 11 12# Register with STAF and get a STAF handle 13 14$handle = STAF::STAFHandle->new("Lang/Perl/Test/Basic"); 15 16if ($handle->{rc} != $STAF::kOk) { 17 print "Error registering with STAF, RC: $handle->{rc}\n"; 18 exit $handle->{rc}; 19} 20 21print "Using handle: $handle->{handle}\n"; 22 23print "\nTesting Class STAFHandle Methods...\n"; 24 25# Test the STAFHandle->submit API 26 27$result = $handle->submit("local", "ping", "ping"); 28 29if (($result->{rc} != $STAF::kOk) or ($result->{result} != "PONG")) { 30 print "Error on ping request.\n"; 31 print "Expected RC: 0, Result: PONG\n"; 32 print "Received RC: $result->{rc}, Result: $result->{result}\n"; 33 exit $result->{rc}; 34} 35 36$result = $handle->submit("local", "var", "resolve string {STAF/Config/Machine}"); 37 38if ($result->{rc} != $STAF::kOk) { 39 print "Error resolving machine, RC: $result->{rc}, Result: $result->{result}\n"; 40 exit $result->{rc}; 41} 42 43print " Verify that auto-unmarshalling result is turned on by default\n"; 44 45# Test the STAFHandle->getDoUnmarshallResult API 46 47if ($handle->getDoUnmarshallResult() != 1) { 48 print "ERROR: handle->getDoUnmarshallResult() != 1\n"; 49 print "Found: ", $handle->getDoUnmarshallResult(), "\n"; 50 exit 1; 51} 52 53$result = $handle->submit("local", "MISC", "WHOAMI"); 54 55if ($result->{rc} != $STAF::kOk) { 56 print "Error on MISC WHOAMI request, RC: $result->{rc}, Result: $result->{result}\n"; 57 exit $result->{rc}; 58} 59 60# Make sure that the resultContext and resultObj variables in the 61# STAFResult class were set correctly since auto-unmarshalling result is on 62 63my $mc = STAF::STAFUnmarshall($result->{result}); 64my $entryMap = $mc->getRootObject(); 65 66if ($result->{resultContext} == undef) { 67 print "ERROR: result->{resultContext} is undef\n"; 68 exit 1; 69} 70elsif ($result->{resultContext}->getRootObject()->{instanceUUID} != $entryMap->{instanceUUID}) { 71 print "STAFResult resultContext variable is not set correctly.\n"; 72 print "Expected: $mc\n"; 73 print "Found: $result->{resultContext}\n"; 74 exit 1; 75} 76 77if ($result->{resultObj} == undef) { 78 print "ERROR: result->{resultObj} is undef\n"; 79 exit 1; 80} 81elsif ($result->{resultObj}->{instanceUUID} != $entryMap->{instanceUUID}) { 82 print "STAFResult resultObj variable is not set correctly.\n"; 83 print "Expected: $entryMap\n"; 84 print "Found: $result->{resultObj}\n"; 85 exit 1; 86} 87 88# Make sure that if turn off auto-unmarshalling result that the 89# resultContext and resultObj variables are set to None since 90# auto-unmarshalling result is off 91 92# Test the STAFHandle.setDoUnmarshallResult API 93 94print " Turn off auto-unmarshalling result"; 95$handle->setDoUnmarshallResult(0); 96 97if ($handle->getDoUnmarshallResult() != 0) { 98 print "ERROR: handle->getDoUnmarshallResult() != 0\n"; 99 print "Found: ", $handle->getDoUnmarshallResult(), "\n"; 100 exit 1; 101} 102 103$result = $handle->submit("local", "MISC", "WHOAMI"); 104 105if ($result->{rc} != $STAF::kOk) { 106 print "Error on MISC WHOAMI request, RC: $result->{rc}, Result: $result->{result}\n"; 107 exit $result->{rc}; 108} 109 110if ($result->{resultContext} != undef) { 111 print "ERROR: result->{resultContext} != undef\n"; 112 print "Found: $result->{resultContext}\n"; 113 exit 1; 114} 115 116if ($result->{resultObj} != undef) { 117 print "ERROR: result->{resultObj} != undef\n"; 118 print "Found: $result->{resultObj}\n"; 119 exit 1; 120} 121 122# Make sure that if turn on auto-unmarshalling result that the 123# resultContext and resultObj variables are set correctly since 124# auto-unmarshalling result is on 125 126print " Turn on auto-unmarshalling result"; 127$handle->setDoUnmarshallResult(1); 128 129if ($handle->getDoUnmarshallResult() != 1) { 130 print "ERROR: handle->getDoUnmarshallResult() != 1\n"; 131 print "Found: ", $handle->getDoUnmarshallResult(), "\n"; 132 exit 1; 133} 134 135$result = $handle->submit("local", "MISC", "WHOAMI"); 136 137if ($result->{rc} != $STAF::kOk) { 138 print "Error on MISC WHOAMI request, RC: $result->{rc}, Result: $result->{result}\n"; 139 exit $result->{rc}; 140} 141 142# Make sure that the resultContext and resultObj variables in the 143# STAFResult class were set correctly since auto-unmarshalling result is on 144 145my $mc = STAF::STAFUnmarshall($result->{result}); 146my $entryMap = $mc->getRootObject(); 147 148if ($result->{resultContext} == undef) { 149 print "ERROR: result->{resultContext} is undef\n"; 150 exit 1; 151} 152elsif ($result->{resultContext}->getRootObject()->{instanceUUID} != $entryMap->{instanceUUID}) { 153 print "STAFResult resultContext variable is not set correctly.\n"; 154 print "Expected: $mc\n"; 155 print "Found: $result->{resultContext}\n"; 156 exit 1; 157} 158 159if ($result->{resultObj} == undef) { 160 print "ERROR: result->{resultObj} is undef\n"; 161 exit 1; 162} 163elsif ($result->{resultObj}->{instanceUUID} != $entryMap->{instanceUUID}) { 164 print "STAFResult resultObj variable is not set correctly.\n"; 165 print "Expected: $entryMap\n"; 166 print "Found: $result->{resultObj}\n"; 167 exit 1; 168} 169 170# Test the STAF::Submit2 API 171 172print "\nTesting STAF::Submit2 API with \"local PING PING\"\n"; 173 174print "\nTesting \$STAF::STAFHandle::kReqSync\n"; 175 176$rc = STAF::Submit2($STAF::STAFHandle::kReqSync, "local", "PING", "PING"); 177 178if (($rc != $STAF::kOk) or ($STAF::Result ne "PONG")) { 179 print " Error submitting \"local PING PING\", expected PONG\n"; 180 print " Received RC: $STAF::RC, Result: $STAF::Result\n"; 181 exit $rc; 182} 183 184print " Result: $STAF::Result\n"; 185 186print "\nTesting \$STAF::STAFHandle::kReqFireAndForget\n"; 187 188$rc = STAF::Submit2($STAF::STAFHandle::kReqFireAndForget, "local", "PING", "PING"); 189 190if (($rc != $STAF::kOk) or ($STAF::Result eq "PONG")) { 191 print " Error submitting \"local PING PING\", expected Request Number\n"; 192 print " Received RC: $STAF::RC, Result: $STAF::Result\n"; 193 exit $rc; 194} 195 196print " Result: $STAF::Result\n"; 197 198print "\nTesting \$STAF::STAFHandle::kReqQueue\n"; 199 200$rc = STAF::Submit2($STAF::STAFHandle::kReqQueue, "local", "PING", "PING"); 201 202if (($rc != $STAF::kOk) or ($STAF::Result eq "PONG")) { 203 print " Error submitting \"local PING PING\", expected Request Number\n"; 204 print " Received RC: $STAF::RC, Result: $STAF::Result\n"; 205 exit $rc; 206} 207 208print " Result: $STAF::Result\n"; 209 210print "\nTesting \$STAF::STAFHandle::kReqRetain\n"; 211 212$rc = STAF::Submit2($STAF::STAFHandle::kReqRetain, "local", "PING", "PING"); 213 214if (($rc != $STAF::kOk) or ($STAF::Result eq "PONG")) { 215 print " Error submitting \"local PING PING\", expected Request Number\n"; 216 print " Received RC: $STAF::RC, Result: $STAF::Result\n"; 217 exit $rc; 218} 219 220print " Result: $STAF::Result\n"; 221 222print "\nTesting \$STAF::STAFHandle::kReqQueueRetain\n"; 223 224$rc = STAF::Submit2($STAF::STAFHandle::kReqQueueRetain, "local", "PING", "PING"); 225 226if (($rc != $STAF::kOk) or ($STAF::Result eq "PONG")) { 227 print " Error submitting \"local PING PING\", expected Request Number\n"; 228 print " Received RC: $STAF::RC, Result: $STAF::Result\n"; 229 exit $rc; 230} 231 232print " Result: $STAF::Result\n"; 233 234# Test the STAFHandle->submit2 API 235 236print "\nTesting STAFHandle->submit2 API with \"local PING PING\"\n"; 237 238print "\nTesting \$STAF::STAFHandle::kReqSync\n"; 239 240$result = $handle->submit2($STAF::STAFHandle::kReqSync, "local", "PING", "PING"); 241 242if (($result->{rc} != $STAF::kOk) or ($result->{result} ne "PONG")) { 243 print " Error submitting \"local PING PING\", expected PONG\n"; 244 print " Received RC: $result->{rc}, Result: $result->{result}\n"; 245 exit $result->{rc}; 246} 247 248print " Result: $result->{result}\n"; 249 250print "\nTesting \$STAF::STAFHandle::kReqFireAndForget\n"; 251 252$result = $handle->submit2($STAF::STAFHandle::kReqFireAndForget, "local", "PING", "PING"); 253 254if (($result->{rc} != $STAF::kOk) or ($result->{result} eq "PONG")) { 255 print " Error submitting \"local PING PING\", expected Request Number\n"; 256 print " Received RC: $result->{rc}, Result: $result->{result}\n"; 257 exit $result->{rc}; 258} 259 260print " Result: $result->{result}\n"; 261 262print "\nTesting \$STAF::STAFHandle::kReqQueue\n"; 263 264$result = $handle->submit2($STAF::STAFHandle::kReqQueue, "local", "PING", "PING"); 265 266if (($result->{rc} != $STAF::kOk) or ($result->{result} eq "PONG")) { 267 print " Error submitting \"local PING PING\", expected Request Number\n"; 268 print " Received RC: $result->{rc}, Result: $result->{result}\n"; 269 exit $result->{rc}; 270} 271 272print " Result: $result->{result}\n"; 273 274print "\nTesting \$STAF::STAFHandle::kReqRetain\n"; 275 276$result = $handle->submit2($STAF::STAFHandle::kReqRetain, "local", "PING", "PING"); 277 278if (($result->{rc} != $STAF::kOk) or ($result->{result} eq "PONG")) { 279 print " Error submitting \"local PING PING\", expected Request Number\n"; 280 print " Received RC: $result->{rc}, Result: $result->{result}\n"; 281 exit $result->{rc}; 282} 283 284print " Result: $result->{result}\n"; 285 286print "\nTesting \$STAF::STAFHandle::kReqQueueRetain\n"; 287 288$result = $handle->submit2($STAF::STAFHandle::kReqQueueRetain, "local", "PING", "PING"); 289 290if (($result->{rc} != $STAF::kOk) or ($result->{result} eq "PONG")) { 291 print " Error submitting \"local PING PING\", expected Request Number\n"; 292 print " Received RC: $result->{rc}, Result: $result->{result}\n"; 293 exit $result->{rc}; 294} 295 296print " Result: $result->{result}\n"; 297 298# Test the privacy APIs 299 300print "\nTesting Privacy APIs...\n"; 301 302my $pw = "secret"; 303my $pwWithPD = STAF::AddPrivacyDelimiters($pw); 304my $expectedResult = "!!@secret@!!"; 305print " STAF::AddPrivacyDelimiters($pw): $pwWithPD\n"; 306if ($pwWithPD != $expectedResult) { 307 print "Error: STAF::AddPrivacyDelimiters($pw): $pwWithPD\n"; 308 print " Should return the following instead: $expectedResult"; 309 exit 1; 310} 311 312my $outString = STAF::EscapePrivacyDelimiters($pwWithPD); 313my $expectedResult = "^!!@secret^@!!"; 314print " STAF::EscapePrivacyDelimiters($pwWithPD): $outString\n"; 315if ($outString != $expectedResult) { 316 print "Error: STAF::EscapePrivacyDelimiters($pwWithPD): $outString\n"; 317 print " Should return the following instead: $expectedResult"; 318 exit 1; 319} 320 321my $outString = STAF::MaskPrivateData($pwWithPD); 322my $expectedResult = "************"; 323print " STAF::MaskPrivateData($pwWithPD): $outString\n"; 324if ($outString != $expectedResult) { 325 print "Error: STAF::MaskPrivateData($pwWithPD): $outString\n"; 326 print " Should return the following instead: $expectedResult"; 327 exit 1; 328} 329 330my $outString = STAF::RemovePrivacyDelimiters($pwWithPD); 331my $expectedResult = "secret"; 332print " STAF::RemovePrivacyDelimiters($pwWithPD): $outString\n"; 333if ($outString != $expectedResult) { 334 print "Error: STAF::RemovePrivacyDelimiters($pwWithPD): $outString\n"; 335 print " Should return the following instead: $expectedResult"; 336 exit 1; 337} 338 339my $dataWith3LevelsPD = '!!@Msg: ^!!@Pw is ^^^!!@secret^^^@!!.^@!!@!!'; 340my $outString = STAF::RemovePrivacyDelimiters($dataWith3LevelsPD); 341my $expectedResult = "Msg: Pw is !!@secret!!@"; 342print " STAF::RemovePrivacyDelimiters($dataWith3LevelsPD): $outString\n"; 343if ($outString != $expectedResult) { 344 print "Error: STAF::RemovePrivacyDelimiters($dataWith3LevelsPD): $outString\n"; 345 print " Should return the following instead: $expectedResult"; 346 exit 1; 347} 348 349my $outString = STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 0); 350print " STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 0): $outString\n"; 351if ($outString != $expectedResult) { 352 print "Error: STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 0): $outString\n"; 353 print " Should return the following instead: $expectedResult"; 354 exit 1; 355} 356 357my $outString = STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 3); 358print " STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 3): $outString\n"; 359if ($outString != $expectedResult) { 360 print "Error: STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 3): $outString\n"; 361 print " Should return the following instead: $expectedResult"; 362 exit 1; 363} 364 365my $expectedResult = 'Msg: !!@Pw is ^^!!@secret^^@!!.@!!'; 366my $outString = STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 1); 367print " STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 1): $outString\n"; 368if ($outString != $expectedResult) { 369 print "Error: STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 1): $outString\n"; 370 print " Should return the following instead: $expectedResult"; 371 exit 1; 372} 373 374my $expectedResult = 'Msg: Pw is !!@secret@!!.'; 375my $outString = STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 2); 376print " STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 2): $outString\n"; 377if ($outString != $expectedResult) { 378 print "Error: STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 2): $outString\n"; 379 print " Should return the following instead: $expectedResult"; 380 exit 1; 381} 382 383my $expectedResult = 'Msg: !!@Pw is ^^!!@secret^^@!!.@!!'; 384my $outString = STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 1); 385print " STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 1): $outString\n"; 386if ($outString != $expectedResult) { 387 print "Error: STAF::RemovePrivacyDelimiters($dataWith3LevelsPD, 1): $outString\n"; 388 print " Should return the following instead: $expectedResult"; 389 exit 1; 390} 391 392my $expectedResult = 'Msg: Pw is !!@secret@!!.'; 393my $outString = STAF::RemovePrivacyDelimiters($outString, 1); 394print " STAF::RemovePrivacyDelimiters($outString, 1): $outString\n"; 395if ($outString != $expectedResult) { 396 print "Error: STAF::RemovePrivacyDelimiters($outString, 1): $outString\n"; 397 print " Should return the following instead: $expectedResult"; 398 exit 1; 399} 400 401# Test private methods passing in an empty string 402my $data = ''; 403my $expectedResult = ''; 404my $outString = STAF::AddPrivacyDelimiters($data); 405print " STAF::AddPrivacyDelimiters($data, 1): $outString\n"; 406if ($outString != $expectedResult) { 407 print "Error: STAF::AddPrivacyDelimiters($data): $outString\n"; 408 print " Should return the following instead: $expectedResult"; 409 exit 1; 410} 411 412my $outString = STAF::EscapePrivacyDelimiters($data); 413print " STAF::EscapePrivacyDelimiters($data, 1): $outString\n"; 414if ($outString != $expectedResult) { 415 print "Error: STAF::EscapePrivacyDelimiters($data): $outString\n"; 416 print " Should return the following instead: $expectedResult"; 417 exit 1; 418} 419 420my $outString = STAF::MaskPrivateData($data); 421print " STAF::MaskPrivateData($data, 1): $outString\n"; 422if ($outString != $expectedResult) { 423 print "Error: STAF::MaskPrivateData($data): $outString\n"; 424 print " Should return the following instead: $expectedResult"; 425 exit 1; 426} 427 428my $outString = STAF::RemovePrivacyDelimiters($data); 429print " STAF::RemovePrivacyDelimiters($data, 1): $outString\n"; 430if ($outString != $expectedResult) { 431 print "Error: STAF::RemovePrivacyDelimiters($data): $outString\n"; 432 print " Should return the following instead: $expectedResult"; 433 exit 1; 434} 435 436# Test private methods passing in non-English data 437 438my $data = "��"; 439my $expectedResult = "!!@��@!!"; 440my $outString = STAF::AddPrivacyDelimiters($data); 441print " STAF::AddPrivacyDelimiters($data, 1): $outString\n"; 442if ($outString != $expectedResult) { 443 print "Error: STAF::AddPrivacyDelimiters($data): $outString\n"; 444 print " Should return the following instead: $expectedResult"; 445 exit 1; 446} 447 448my $data = "!!@��@!!"; 449my $expectedResult = "^!!@��!@!!"; 450my $outString = STAF::EscapePrivacyDelimiters($data); 451print " STAF::EscapePrivacyDelimiters($data, 1): $outString\n"; 452if ($outString != $expectedResult) { 453 print "Error: STAF::EscapePrivacyDelimiters($data): $outString\n"; 454 print " Should return the following instead: $expectedResult"; 455 exit 1; 456} 457 458my $outString = STAF::MaskPrivateData($data); 459my $expectedResult = "********"; 460print " STAF::MaskPrivateData($data, 1): $outString\n"; 461if ($outString != $expectedResult) { 462 print "Error: STAF::MaskPrivateData($data): $outString\n"; 463 print " Should return the following instead: $expectedResult"; 464 exit 1; 465} 466 467my $outString = STAF::RemovePrivacyDelimiters($data); 468my $expectedResult = "��"; 469print " STAF::RemovePrivacyDelimiters($data, 1): $outString\n"; 470if ($outString != $expectedResult) { 471 print "Error: STAF::RemovePrivacyDelimiters($data): $outString\n"; 472 print " Should return the following instead: $expectedResult"; 473 exit 1; 474} 475 476# Test the Monitor wrapper APIs 477 478print "\nTesting Monitor Service Wrapper...\n"; 479 480my $machine = $result->{result}; 481print " STAF/Config/Machine=$machine\n"; 482 483print " Log a message to the monitor service\n"; 484$rc = STAF::Monitor::Log("Hello World"); 485if ($rc != $STAF::kOk) { 486 print "Error logging message to Monitor, RC: $rc\n"; 487 exit $rc; 488} 489 490$mon = STAF::STAFMonitor->new($handle); 491$result = $mon->log("Hello World Again"); 492if ($result->{rc} != $STAF::kOk) { 493 print "Error logging message to Monitor, RC: $result->{rc}\n"; 494 exit $rc; 495} 496 497print "\nTesting Log Service Wrapper...\n"; 498 499print " Init Log\n"; 500$rc = STAF::Log::Init("TestCase1", "GLOBAL", "FATAL ERROR"); 501print " Log a message\n"; 502$rc = STAF::Log::Log("WARNING", "Unable to find specified file"); 503if ($rc != $STAF::kOk) { 504 print "Error logging message to Log, RC: $rc\n"; 505 exit $rc; 506} 507 508print " Init TestCase2 log\n"; 509$log = STAF::STAFLog->new($handle, "TestCase2", "GLOBAL", "FATAL ERROR"); 510$result = $log->log("WARNING", "Unable to find specified file"); 511if ($result->{rc} != $STAF::kOk) { 512 print "Error logging message to Log, RC: $result->{rc}\n"; 513 exit $result->{rc}; 514} 515 516$logtype = $log->getLogType(); 517print " Log Type: $logtype\n"; 518$logmask = $log->getMonitorMask(); 519print " Log's Monitor Mask: $logmask\n"; 520$system = $log->getSystemName(); 521print " Log Service System Name: $system\n"; 522$service = $log->getServiceName(); 523print " Log Service Name: $service\n"; 524 525print "\nTesting Class STAFMapClassDefinition's methods...\n"; 526 527print " Testing STAFMapClassDefinition new() method...\n"; 528my $myMapClassDef = STAF::STAFMapClassDefinition->new('Test/MyMap'); 529 530print " Testing STAFMapClassDefinition addKey() method...\n"; 531$myMapClassDef->addKey('name', 'Name'); 532$myMapClassDef->addKey('exec', "Executable"); 533$myMapClassDef->addKey('testType', 'Test Type'); 534 535print " Testing STAFMapClassDefinition setKeyProperty() method...\n"; 536$myMapClassDef->setKeyProperty('testType', 'display-short-name', 'Test'); 537$myMapClassDef->addKey('outputs', 'Outputs'); 538 539print " Testing STAFMapClassDefinition name() method...\n"; 540my $myMapClassName = $myMapClassDef->name(); 541 542my $foundKeys = 0; 543 544print " Testing STAFMapClassDefinition keys() method...\n"; 545for my $key ($myMapClassDef->keys()) { 546 if ($key->{'key'} eq "name") { 547 $foundKeys = $foundKeys + 1; 548 } 549 elsif ($key->{'key'} eq "exec") { 550 $foundKeys = $foundKeys + 1; 551 } 552 elsif (($key->{'key'} eq "testType") && ($key->{'display-short-name'} eq "Test")) { 553 $foundKeys = $foundKeys + 1; 554 print " key=$key->{'key'} display-name=$key->{'display-name'}". 555 " display-short-name=$key->{'display-short-name'}\n"; 556 } 557 elsif ($key->{'key'} eq "outputs") { 558 $foundKeys = $foundKeys + 1; 559 } 560} 561 562if ($foundKeys != 4) { 563 print "ERROR: Map Class Definition does not contain the correct 4 keys.\n". 564 "Contains $foundKeys keys.\n"; 565 exit 1; 566} 567 568print " Testing STAFMapClassDefinition createInstance() method...\n"; 569my $myMapClass = $myMapClassDef->createInstance(); 570 571# Create a marshalling context and assign a map class definition to it 572 573print "\nTesting Class STAFMarshallingContext Methods...\n"; 574 575print " Testing STAFMarshallingContext new() method...\n"; 576my $mc = STAF::STAFMarshallingContext->new(); 577 578print " Testing STAFMarshallingContext setMapClassDefinition() method...\n"; 579$mc->setMapClassDefinition($myMapClassDef); 580 581print " Testing STAFMarshallingContext hasMapClassDefinition() method...\n"; 582if (!$mc->hasMapClassDefinition('Test/MyMap')) 583{ 584 print "Oops, map class 'Test/MyMap' doesn't exist\n"; 585 exit 1; 586} 587 588# Get the map class definition from the marshalling context 589 590print " Testing STAFMarshallingContext getMapClassDefinition() method...\n"; 591my $mapClassDef = $mc->getMapClassDefinition('Test/MyMap'); 592 593# Set the root object for a marshalling context to be a string 594# and get the root object. 595 596$data = "This is a string"; 597$mc->setRootObject($data); 598my $rootObj = $mc->getRootObject(); 599 600# Set the root object for a marshalling context to be a hash (aka map) 601 602print " Testing STAFMarshallingContext getRootObject() method...\n"; 603 604my $myTestMap = { 605 'name' => 'TestA', 606 'exec' => '/tests/TestA.py', 607 'testType' => 'FVT', 608 'outputs' => [ 'TestA.out', 'TestA.err' ] 609 }; 610 611$mc->setRootObject($myTestMap); 612my $rootObj = $mc->getRootObject(); 613 614print " Testing STAFMarshallingContext getPrimaryObject() method...\n"; 615my $priObj = $mc->getPrimaryObject(); 616 617if (!($priObj eq $mc)) { 618 print 'Error: $mc->getPrimaryObject() != $mc', "\n"; 619 print "mc->getPrimaryObject()=$priObj\n"; 620 print "mc-$mc\n"; 621 exit 1; 622} 623 624print " Testing STAFMarshallingContext formatObject() method...\n"; 625my $formattedOutput1 = $mc->formatObject(); 626my $formattedOutput2 = STAF::STAFFormatObject($mc->getRootObject(), $mc); 627 628if (!($formattedOutput1 eq $formattedOutput2)) { 629 print "Error in mc->formatObject() or STAF::STAFFormatObject function\n"; 630 print "formattedOutput1:\n$formattedOutput1\n"; 631 print "formattedOutput2:\n$formattedOutput2\n"; 632 exit 1; 633} 634 635print " Testing STAFMarshallingContext marshall() method...\n"; 636 637# Test the marshall function using a MapClassDefinition 638 639my $expectedResult2 = 640 '@SDT/*:558:@SDT/{:398::13:map-class-map@SDT/{:370::10:Test/MyMap' . 641 '@SDT/{:345::4:keys@SDT/[4:298:@SDT/{:50::12:display-name' . 642 '@SDT/$S:4:Name:3:key@SDT/$S:4:name@SDT/{:57::12:display-name' . 643 '@SDT/$S:10:Executable:3:key@SDT/$S:4:exec@SDT/{:95::12:display-name' . 644 '@SDT/$S:9:Test Type:3:key@SDT/$S:8:testType:18:display-short-name' . 645 '@SDT/$S:4:test@SDT/{:56::12:display-name@SDT/$S:7:Outputs:3:key' . 646 '@SDT/$S:7:outputs:4:name@SDT/$S:10:Test/MyMap@SDT/{:138::7:outputs' . 647 '@SDT/[2:38:@SDT/$S:9:TestA.out@SDT/$S:9:TestA.err:8:testType' . 648 '@SDT/$S:3:FVT:4:name@SDT/$S:5:TestA:4:exec@SDT/$S:15:/tests/TestA.py'; 649 650my $marshalledResult2 = STAF::STAFMarshall($mc, $mc); 651 652if (length($marshalledResult2) != length($expectedResult2)) { 653 print "Error: Wrong output for marshall function\n"; 654 print "Expected to find:\n$expectedResult2\n"; 655 print "Found:\n$marshalledResult2\n"; 656 exit 1; 657} 658 659my $marshalledResult3 = $mc->marshall(); 660 661if (length($marshalledResult3) != length($expectedResult2)) { 662 print "Error: Wrong output for marshall function\n"; 663 print "Expected to find:\n$expectedResult2\n"; 664 print "Found:\n$marshalledResult3\n"; 665 exit 1; 666} 667 668# Create a map class definition without a name 669 670my $myDef = STAF::STAFMapClassDefinition->new(); 671$myDef->addKey('key1', 'Key 1'); 672my $myDefName = $myDef->name(); 673 674############################################ 675# Next, test the STAFUnmarshall function # 676############################################ 677print "\nTesting STAFUnmarshall()...\n"; 678 679# Submit a FS QUERY ENTRY request and unmarshall it's result (a map) 680 681print "\n STAF local FS QUERY ENTRY {STAF/Config/ConfigFile}\n\n"; 682$result = $handle->submit("local", "FS", "QUERY ENTRY {STAF/Config/ConfigFile}"); 683 684if ($result->{rc} != $STAF::kOk) { 685 print "Error on FS QUERY ENTRY request.\n"; 686 print "Expected RC: 0\n"; 687 print "Received RC: $result->{rc}, Result: $result->{result}\n"; 688 exit $result->{rc}; 689} 690 691if (!STAF::STAFIsMarshalledData($result->{result})) { 692 print "ERROR: Not marshalled data: Result: $result->{result}\n"; 693} 694 695my $mc = STAF::STAFUnmarshall($result->{result}); 696my $entryMap = $mc->getRootObject(); 697 698if ($entryMap->{type} eq "F") { 699 print " File Name : $entryMap->{name}\n"; 700 print " Size : $entryMap->{lowerSize}\n"; 701 print " Date Last Modified: $entryMap->{lastModifiedTimestamp}\n"; 702} 703else { 704 print "Error on FS QUERY ENTRY result.\n"; 705 print "$fileName is not a file. Type=$entryMap->{type}\n"; 706 exit 1; 707} 708 709# Determine if running test on a Windows or Unix machine 710 711my $request = "RESOLVE STRING {STAF/Config/OS/Name}"; 712print "\n STAF local VAR $request\n"; 713 714$result = $handle->submit("local", "VAR", $request); 715 716if ($result->{rc} != $STAF::kOk) { 717 print "Error on STAF local VAR $request\n"; 718 print "Expected RC: 0\n"; 719 print "Received RC: $result->{rc}, Result: $result->{result}\n"; 720 exit $result->{rc}; 721} 722 723my $osName = $result->{result}; 724print "\n STAF/Config/OS/Name: $osName\n"; 725 726# Use command "dir" if on Windows or use "ls" if on Unix 727 728my $command = "dir {STAF/Config/STAFRoot}"; 729 730if (($osName eq "Linux") || 731 ($osName eq "HP-UX") || 732 ($osName eq "AIX") || 733 ($osName eq "SunOS") || 734 ($osName eq "OS400") || 735 ($osName eq "OS/390") || 736 ($osName eq "FreeBSD") || 737 ($osName eq "Darwin")) { 738 $command = "ls {STAF/Config/STAFRoot}"; 739} 740 741# Submit a PROCESS START request without a WAIT option 742 743my $request = "START SHELL COMMAND ".STAF::WrapData($command). 744 " RETURNSTDOUT STDERRTOSTDOUT"; 745 746print "\n STAF local PROCESS $request\n"; 747 748$result = $handle->submit("local", "PROCESS", $request); 749 750if ($result->{rc} != $STAF::kOk) { 751 print "Error on STAF local PROCESS $request\n"; 752 print "Expected RC: 0\n"; 753 print "Received RC: $result->{rc}, Result: $result->{result}\n"; 754 exit $result->{rc}; 755} 756 757print "\n Process Handle: $result->{result}\n"; 758 759# Submit a PROCESS START request and wait for it to complete 760 761my $request = "START SHELL COMMAND ".STAF::WrapData($command). 762 " RETURNSTDOUT STDERRTOSTDOUT WAIT"; 763 764print "\n STAF local PROCESS $request\n"; 765 766$result = $handle->submit("local", "PROCESS", $request); 767 768if ($result->{rc} != $STAF::kOk) { 769 print "Error on STAF local PROCESS $request\n"; 770 print "Expected RC: 0\n"; 771 print "Received RC: $result->{rc}, Result: $result->{result}\n"; 772 exit $result->{rc}; 773} 774 775# Unmarshall the result which is a marshalling context whose 776# root object is a map containing keys 'rc', and 'fileList'. 777# The value for 'fileList' is a list of the returned files. 778# Each entry in the list consists of a map that contains keys 779# 'rc' and 'data'. In our PROCESS START request, we returned 780# one file, stdout (and returned stderr to this same file). 781 782my $mc = STAF::STAFUnmarshall($result->{result}); 783my $mcRootObject = $mc->getRootObject(); 784 785# Verify that the process rc is 0 786 787my $processRC = $mcRootObject->{rc}; 788 789if ($processRC != $STAF::kOk) { 790 print " Process RC: $processRC\n"; 791 exit $processRC; 792} 793 794# Verify that the rc is 0 for returning data for the Stdout file 795 796my $stdoutRC = $mcRootObject->{fileList}[0]{rc}; 797 798if ($stdoutRC != $STAF::kOk) { 799 print "Error on retrieving process's stdout data.\n"; 800 print "Expected RC: 0\n"; 801 print "Received RC: $stdoutRC\n"; 802 exit $stdoutRC; 803} 804 805# Print the data in the stdout file created by the process 806 807my $stdoutData = $mcRootObject->{fileList}[0]{data}; 808 809print "\n Process Stdout File Contains:\n"; 810print "$stdoutData\n"; 811 812# Test unmarshalling data that contains indirect marshalled data 813 814print "Test unmarshalling data that contains indirect marshalled data\n\n"; 815 816# Create an array (aka list) of hashes (aka maps) 817my @testList = ( 818 {name => 'TestA', exec => '/tests/TestA.py'}, 819 {name => 'TestB', exec => '/tests/TestB.sh'}, 820 {name => 'TestC', exec => '/tests/TestC.cmd'} 821 ); 822 823$result = $handle->submit("local", "FS", "QUERY ENTRY {STAF/Config/ConfigFile}"); 824 825if ($result->{rc} != $STAF::kOk) { 826 print "Error on FS QUERY ENTRY request.\n"; 827 print "Expected RC: 0\n"; 828 print "Received RC: $result->{rc}, Result: $result->{result}\n"; 829 exit $result->{rc}; 830} 831 832# Add some marshalled data as an entry to the list 833push @testList, $result->{result}; 834 835my $mcWithIndirectObjects = $mc; 836$mcWithIndirectObjects->setRootObject(\@testList); 837my $marshalledData = $mcWithIndirectObjects->marshall(); 838print "Unmarshall using IGNORE_INDIRECT_OBJECTS=>0 flag\n"; 839my $mc2 = STAF::STAFUnmarshall($marshalledData, IGNORE_INDIRECT_OBJECTS=>0); 840my $formattedData2 = STAF::STAFFormatObject($mc2->getRootObject(), $mc2); 841print $formattedData2, "\n"; 842 843print "Unmarshall using IGNORE_INDIRECT_OBJECTS=>1 flag\n"; 844my $mc3 = STAF::STAFUnmarshall($marshalledData, $mc2, IGNORE_INDIRECT_OBJECTS=>1); 845my $formattedData3 = STAF::STAFFormatObject($mc3->getRootObject(), $mc3); 846print $formattedData3, "\n"; 847 848if ($formattedData2 eq $formattedData3) { 849 print "formattedData2 eq formattedData3\n"; 850} 851 852if (!($formattedData2 eq $formattedData3) && 853 (index($formattedData2, '@SDT/*') == -1) && 854 (index($formattedData3, '@SDT/*') > 0)) { 855 # Success 856} 857else 858{ 859 print "Error using IGNORE_INDIRECT_OBJECTS flag on unmarshall\n"; 860 print "\nFormatted output using IGNORE_INDIRECT_OBJECTS=>0 flag:\n"; 861 print $formattedData2, "\n"; 862 print "\nFormatted output using IGNORE_INDIRECT_OBJECTS=>1 flag:\n"; 863 print $formattedData3, "\n"; 864 exit 1; 865} 866 867# Test unmarshalling data that contains invalid marshalled data 868# XXX: This test is commented out because it doesn't work yet because the fix 869# made for Bug #2515811 hasn't been implemented yet for the Perl unmarshall 870# method 871 872#print "\n\nTest unmarshalling data that contains invalid marshalled data\n\n"; 873 874# Create some invalid marshalling data and queue it; Get it off the queue, 875# and unmarshall it and verify doesn't cause an error and returns the correct 876# data 877 878#my $message = '@SDT/{:177::2:RC@SDT/$S:1:0:6:IPInfo@SDT/$S:36:' . 879# '9.42.126.76|255.255.252.0|9.42.124.1:3:Msg@SDT/$S:46:Static IP ' . 880# 'arguments are processed successfully:9:Timestamp@SDT/$S:19:2009-01-16 14:41:45' . 881# 'Connecting to: http://9.42.106.28:8080'; 882 883#my $result = $handle->submit("local", "QUEUE", "QUEUE MESSAGE $message"); 884 885#if ($result->{rc} != $STAF::kOk) { 886# print "Error on QUEUE QUEUE MESSAGE request.\n"; 887# print "Expected RC: 0\n"; 888# print "Received RC: $result->{rc}, Result: $result->{result}\n"; 889# exit $result->{rc}; 890#} 891 892#my $mc = STAF::STAFUnmarshall($result->{result}); 893#my $messageMap = $mc->getRootObject(); 894 895#print "Queued message map:\n\n$messageMap\n\n"; 896#print STAF::STAFFormatObject($messageMap); 897#print "\n\n"; 898 899#if (!($messageMap->{message} eq $message)) { 900# print "ERROR: Message containing invalid marshalled data not unmarshalled properly\n"; 901# print " Expected message: $message\n"; 902# print " Received message: $messageMap->{message}\n"; 903# exit 1; 904#} 905 906############################################ 907# Next, test the STAFMarshall function # 908############################################ 909 910print "\n\nTesting STAFMarshall()...\n\n"; 911 912# Test marshalling a scalar (e.g. a string) 913 914my $marshalledResult = STAF::STAFMarshall("This is a string"); 915print "Marshalled result from marshalling a string:\n$marshalledResult\n\n"; 916my $expectedLength = 27; 917if (length($marshalledResult) != $expectedLength) { 918 print "ERROR: Incorrect marshalled data. Length is ", 919 length($marshalledResult), " but should be $expectedLength\n\n"; 920} 921 922# Test marshalling a None scalar 923 924my $data = undef; 925my $marshalledResult = STAF::STAFMarshall($data); 926print "Marshalled result from marshalling a None scalar:\n$marshalledResult\n\n"; 927if (!($marshalledResult eq '@SDT/$0:0:')) { 928 print 'ERROR: Incorrect marshalled data. Expected: @SDT/$0:0:', "\n\n"; 929} 930my $mc = STAF::STAFUnmarshall($marshalledResult); 931if (!($mc->formatObject() eq "<None>")) { 932 print "ERROR: FormatObject for a None scalar isn't <None>\n"; 933 print " Result: $mc->formatObject()\n\n"; 934} 935 936# Test marshalling a hash 937 938my $myTestMap = { 939 'name' => 'TestA', 940 'exec' => '/tests/TestA.py', 941 'testType' => 'FVT', 942 'outputs' => [ 'TestA.out', 'TestA.err' ] 943 }; 944my $marshalledResult = STAF::STAFMarshall($myTestMap); 945print "Marshalled result from marshalling a hash:\n$marshalledResult\n\n"; 946my $expectedLength = 149; 947if (length($marshalledResult) != $expectedLength) { 948 print "ERROR: Incorrect marshalled data. Length is ", 949 length($marshalledResult), " but should be $expectedLength\n\n"; 950} 951 952# Test marshalling an array 953 954my @testList = ( 955 {name => 'TestA', exec => '/tests/TestA.py'}, 956 {name => 'TestB', exec => '/tests/TestB.sh'}, 957 {name => 'TestC', exec => '/tests/TestC.cmd'} 958 ); 959my $marshalledResult = STAF::STAFMarshall(\@testList); 960print "Marshalled result from marshalling an array:\n$marshalledResult\n\n"; 961my $expectedLength = 208; 962if (length($marshalledResult) != $expectedLength) { 963 print "ERROR: Incorrect marshalled data. Length is ", 964 length($marshalledResult), " but should be $expectedLength\n\n"; 965} 966 967# Test marshalling data using a marshalling context 968 969# Create a marshalling context and marshall it, and unmarshall it 970 971# Create a map class definition 972my $myMapClassDef = STAF::STAFMapClassDefinition->new('Test/MyMap'); 973$myMapClassDef->addKey('name', 'Name'); 974$myMapClassDef->addKey('exec', 'Executable'); 975 976# Create an array (aka list) of hashes (aka maps) 977my @testList = ( 978 {name => 'TestA', exec => '/tests/TestA.py'}, 979 {name => 'TestB', exec => '/tests/TestB.sh'}, 980 {name => 'TestC', exec => '/tests/TestC.cmd'} 981 ); 982 983# Create a reference to the array (aka list) 984my $testList_ref = \@testList; 985 986# Create a marshalling context with one map class definition 987 988my $mc = STAF::STAFMarshallingContext->new(); 989$mc->setMapClassDefinition($myMapClassDef); 990 991# Create an array (aka list) of map class map data 992 993my @myTestList; 994 995foreach my $test (@$testList_ref) { 996 my $testMap = $myMapClassDef->createInstance(); 997 $testMap->{'name'} = $test->{'name'}; 998 $testMap->{'exec'} = $test->{'exec'}; 999 push @myTestList, $testMap; 1000} 1001 1002# Assign a reference to the array (aka list) as the root object 1003# for the marshalling context 1004$mc->setRootObject(\@myTestList); 1005 1006# Create a string from the marshalling context 1007# This string could be a message that you log or send to a queue, etc. 1008 1009my $marshalledResult = $mc->marshall(); 1010print "Marshalled result from marshalling a marshalling context:\n$marshalledResult\n\n"; 1011my $expectedLength = 457; 1012if (length($marshalledResult) != $expectedLength) { 1013 print "ERROR: Incorrect marshalled data. Length is ", 1014 length($marshalledResult), " but should be $expectedLength\n\n"; 1015} 1016 1017# Convert the marshalled string representation back into an array (aka list) 1018 1019my $mc2 = STAF::STAFUnmarshall($marshalledResult); 1020my $message2 = $mc2->marshall(); 1021my $theTestList = $mc2->getRootObject(); 1022 1023if (length($marshalledResult) != length($message2)) { 1024 print 'Error: length($marshalledResult) != length($message2)', "\n"; 1025 print "Message:\n$marshalledResult\n"; 1026 print "Message2:\n$message2\n"; 1027 exit 1; 1028} 1029 1030 1031############################################ 1032# Next, test the STAFFormatObject function # 1033############################################ 1034 1035print "Testing STAFFormatObject()..."; 1036 1037print "\n\nPrinting formatted output for a scalar (e.g. a string):\n"; 1038print STAF::STAFFormatObject("This is a string"); 1039 1040print "\n\nPrinting formatted output for None scalar (e.g. undef):\n"; 1041print STAF::STAFFormatObject(undef); 1042 1043if (!(STAF::STAFFormatObject(undef) eq '<None>')) { 1044 print "ERROR: Wrong FormatObject for a None scalar\n"; 1045 print " Result: ", STAF::STAFFormatObject(undef), "\n\n"; 1046} 1047 1048print "\n\nPrinting formatted output for an array:\n"; 1049my @testList = ( 1050 {name => 'TestA', exec => '/tests/TestA.py'}, 1051 {name => 'TestB', exec => '/tests/TestB.sh'}, 1052 {name => 'TestC', exec => '/tests/TestC.cmd'} 1053 ); 1054print STAF::STAFFormatObject(\@testList); 1055 1056print "\n\nPrinting formatted output for a hash:\n"; 1057print STAF::STAFFormatObject($myTestMap); 1058 1059my $fileName = '{STAF/Config/ConfigFile}'; 1060 1061my $result = $handle->submit('local', 'FS', "QUERY ENTRY $fileName"); 1062 1063if (result->{rc} != STAFResult.Ok) { 1064 print "FS QUERY ENTRY $fileName failed"; 1065 print "RC=$result->{rc}, Result=$result->{result}"; 1066 exit 1; 1067} 1068 1069my $mc = STAF::STAFUnmarshall($result->{result}); 1070print "\n\nPrinting formatted output for FS QUERY ENTRY using STAFFormatObject\n"; 1071print STAF::STAFFormatObject($mc->getRootObject(), $mc); 1072print "\n\nPrinting formatted output for FS QUERY ENTRY using formatObject\n"; 1073print $mc->formatObject(); 1074 1075# Test STAFResult->new 1076 1077print "\n\nTesting STAFResult->new()...\n"; 1078 1079my $result = STAF::STAFResult->new(0, 'Successful'); 1080if (($result->{rc} != $STAF::kOk) or 1081 (!$result->{result} eq 'Successful')) { 1082 print "ERROR: Wrong STAFResult.". 1083 "RC: $result->{rc} Result: $result->{result}\n"; 1084 exit $result->{rc}; 1085} 1086 1087# Test STAF::WrapData function 1088 1089print "\nTesting STAF::WrapData()...\n"; 1090 1091my $message = "Hello World"; 1092$result = $handle->submit( 1093 "local", "monitor", "log message ".STAF::WrapData($message)); 1094 1095if ($result->{rc} != $STAF::kOk) { 1096 print "Error logging message to Monitor,". 1097 " RC: $result->{rc} Result: $result->{result}\n"; 1098 exit $result->{rc}; 1099} 1100 1101# Unregister the handle 1102 1103print "\nUnregistering handle $handle->{handle}\n"; 1104 1105$rc = $handle->unRegister(); 1106if ($rc != $STAF::kOk) { 1107 print "Error unregistering with STAF, RC: $STAF::RC\n"; 1108 exit $rc; 1109} 1110 1111print "\n *** All tests successful ***\n"; 1112 1113