1#!/usr/bin/perl 2######################################################################### 3 4 #************************************************************** 5# 6# Licensed to the Apache Software Foundation (ASF) under one 7# or more contributor license agreements. See the NOTICE file 8# distributed with this work for additional information 9# regarding copyright ownership. The ASF licenses this file 10# to you under the Apache License, Version 2.0 (the 11# "License"); you may not use this file except in compliance 12# with the License. You may obtain a copy of the License at 13# 14# http://www.apache.org/licenses/LICENSE-2.0 15# 16# Unless required by applicable law or agreed to in writing, 17# software distributed under the License is distributed on an 18# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 19# KIND, either express or implied. See the License for the 20# specific language governing permissions and limitations 21# under the License. 22# 23#************************************************************** 24 25 26 27#################################################################### 28# File Name: converterlib.pm 29# Version : 1.0 30# Project : XMerge 31# Author : Brian Cameron 32# Date : 5th Sept. 2001 33# 34# This script enters text at position x,y on screen. 35# 36# Parameter 37# x-coordinate 38# y-coordinate 39# Text to enter 40# 41########################################################################## 42 43use EmRPC; # EmRPC::OpenConnection, CloseConnection 44use EmFunctions; 45use EmUtils; 46 47# Set global_debug flag 48# 49$global_debug = $ENV{'ZENDEBUG'}; 50#$em_script_home = "/export/home/test/qadir/bin"; 51$em_script_home = $ENV{'EM_SCRIPT_HOME'}; 52#$qa_script_home = "/export/home/test/qadir/qa-new/bin"; 53 $qa_script_home = $ENV{'QA_SCRIPT_HOME'}; 54# 55# CONVERT FUNCTIONS 56# 57 58# convert_to_pdb 59# directory - directory containing the xml-orig and pdb-orig 60# subdirectories. 61# file - file to convert 62# extension - extension of file to convert (sxw or sxc) 63# convert_to - what PDB format to convert into. 64# 65# Returns 0 if success, -1 otherwise. 66# 67# Converts file from XML to PDB 68# 69sub convert_to_pdb 70{ 71 my $directory = $_[0]; 72 my $file = $_[1]; 73 my $extension = $_[2]; 74 my $convert_to = $_[3]; 75 my $pdb_directory = $_[4]; 76 my $rc = 0; 77 my $xmlfile = "$directory/$file.$extension"; 78 my $pdbdir = "$pdb_directory"; 79 80 &enter_func("convert_to_pdb"); 81 82 if (! -f "$xmlfile") 83 { 84 print "\nERROR, file $xmlfile does not exist\n"; 85 $rc = -1; 86 } 87 if (! -d "$pdbdir") 88 { 89 print "\nERROR, directory $directory/pdb-orig does not exist\n"; 90 $rc = -1; 91 } 92 93 if ($rc != -1) 94 { 95 if ("$convert_to" eq "application/x-minicalc") 96 { 97 # Move all files over. 98 # 99 my $i = 1; 100 101 while (-f "$pdbdir/$file-Sheet$i.pdb") 102 { 103 my $pdbfile = "$pdbdir/$file-Sheet$i.pdb"; 104 105 print "\n"; 106 107 if (-f "$pdbfile.old") 108 { 109 print "Removing $pdbfile.old\n"; 110 `/bin/rm -f $pdbfile.old`; 111 } 112 113 print "Moving $pdbfile file to $pdbfile.old\n"; 114 `mv "$pdbfile" "$pdbfile.old"`; 115 116 $i++; 117 } 118 } 119 else 120 { 121 if (-f "$pdbdir/$file.pdb") 122 { 123 print "\n"; 124 125 if (-f "$pdbdir/$file.pdb.old") 126 { 127 print "Removing $pdbdir/$file.pdb.old\n"; 128 `/bin/rm -f $pdbdir/$file.pdb.old`; 129 } 130 131 print "Moving $pdbdir/$file.pdb file to $pdbdir/$file.pdb.old\n"; 132 `mv "$pdbdir/$file.pdb" "$pdbdir/$file.pdb.old"` 133 } 134 } 135 136 &start_rd($extension, $convert_to, $xmlfile, ""); 137 138 if ("$convert_to" eq "application/x-minicalc") 139 { 140 # Must handle minicalc separately since it can 141 # convert to multiple files with this file name 142 # convention. 143 # 144 print "Moving $file-Sheet*.pdb files to $pdbdir\n"; 145 `mv $file-Sheet*.pdb $pdbdir`; 146 `chmod 666 $pdbdir/$file-*.pdb`; 147 } 148 else 149 { 150 print "Moving $file.pdb file to $pdbdir\n"; 151 `mv $file.pdb $pdbdir`; 152 `chmod 666 $pdbdir/$file.pdb`; 153 } 154 } 155 156 &leave_func("convert_to_pdb"); 157 158 return $rc; 159} 160 161# convert_to_xml 162# xmldir - directory to contain the xml output. 163# xmlorigdir - directory to contain the xml input (used for merge) 164# pdbfile - file to convert 165# convert_from - what PDB format to convert from. 166# extension - extension of file to convert (sxw or sxc) 167# output - output filename to create 168# merge_opt - 1 if convert and merge, 0 if convert only 169# 170# Returns 0 if success, -1 otherwise. 171# 172# Converts file from PDB to XML 173# 174sub convert_to_xml 175{ 176 my $xmldir = $_[0]; 177 my $xmlorigdir = $_[1]; 178 my $pdbfile = $_[2]; 179 my $convert_from = $_[3]; 180 my $extension = $_[4]; 181 my $output = $_[5]; 182 my $merge_opt = $_[6]; 183 my $rc = 0; 184 185 &enter_func("convert_to_xml"); 186 187 my @args = split(/ /,$pdbfile); 188 189 for ($i=0;$i <= $#args; $i++) 190 { 191 if (! -f "@args[$i]") 192 { 193 print "\nERROR, file $pdbfile does not exist\n"; 194 $rc = -1; 195 } 196 } 197 198 if (! -f "$xmlorigdir/$output.$extension") 199 { 200 print "\nERROR, file $xmlorigdir/$output.$extension does not exist\n"; 201 $rc = -1; 202 } 203 if (! -d "$xmldir") 204 { 205 print "\nERROR, directory $xmlorigdir does not exist\n"; 206 $rc = -1; 207 } 208 if (! -d "$xmlorigdir") 209 { 210 print "\nERROR, directory $xmldir does not exist\n"; 211 $rc = -1; 212 } 213 214 if ($rc != -1) 215 { 216 if ($merge_opt == 1) 217 { 218 print "Copying <$xmlorigdir/$output.$extension> to <$xmldir>\n"; 219 `cp $xmlorigdir/$output.$extension $xmldir/`; 220 221 my $check_stamp = (stat("$xmldir/$output.$extension"))[9]; 222 223 &start_rd($convert_from, $extension, $pdbfile, 224 "$xmldir/$output.$extension"); 225 226 227 # No need to move the file to the $xmldir since the merge 228 # argument specifies the output file. 229 230 my $check_stamp_update = (stat("$xmldir/$output.$extension"))[9]; 231 if ($check_stamp eq $check_stamp_update) 232 { 233 print "\nERROR, Problem while merging <$xmldir/$output.$extension>\n"; 234 `mv $xmldir/$output.$extension $xmldir/$output.$extension.err`; 235 } 236 } 237 else 238 { 239 &start_rd($convert_from, $extension, $pdbfile, ""); 240 241 print "Moving $output.$extension to $xmldir\n"; 242 `mv $output.$extension $xmldir`; 243 `chmod 666 $xmldir/$output.$extension`; 244 } 245 } 246 247 &leave_func("convert_to_xml"); 248 249 return $rc; 250} 251 252# start_rd 253# from - format to convert from 254# to - format to convert to 255# file - file to convert 256# merge - merge filename ("" indicates convert-only with no merge) 257# 258# converts file from/to the specified formats. 259# 260sub start_rd 261{ 262 my $from = $_[0]; 263 my $to = $_[1]; 264 my $file = $_[2]; 265 my $merge = $_[3]; 266 267 print "\nConverting from $from to $to.\n"; 268 if ($global_debug) 269 { 270 &print_debug ("rd command is:\n"); 271 } 272 273 if ($merge eq "") 274 { 275 &print_debug (" $em_script_home/rd -from $from -to $to $file\n"); 276 print "\nConverting from $from to $to with no merge.\n"; 277 `$em_script_home/rd -from $from -to $to $file`; 278 } 279 else 280 { 281 &print_debug (" $em_script_home/rd -from $from -to $to -merge $merge $file\n"); 282 print "\nConverting from $from to $to with merge.\n"; 283 `$em_script_home/rd -from $from -to $to -merge $merge $file`; 284 } 285 286 print "Done converting.\n\n"; 287} 288 289# 290# POSE INTERACTION FUNCTIONS 291# 292 293# open_connection 294# display_debug - debug will be displayed if not 0 295# 296# Opens the connection to pose. 297# 298sub open_connection 299{ 300 my $display_debug = $_[0]; 301 my $rc; 302 303 EmRPC::OpenConnection(6415, "localhost"); 304 305 if ($display_debug && $global_debug) 306 { 307 print "\nPose Connection Opened\n"; 308 } 309} 310 311# close_connection 312# display_debug - debug will be displayed if not 0 313# 314# Closes the connection to pose. 315# 316sub close_connection 317{ 318 my $display_debug = $_[0]; 319 320 EmRPC::CloseConnection(); 321 322 if ($display_debug && $global_debug) 323 { 324 print "\nPose Connection Closed\n"; 325 } 326} 327 328# start_pose 329# pose_exe - name of pose executable. 330# apps_load - The PRC files to load into pose, can be a comma 331# separated list. 332# run_prog - Program to run at startup. 333# timeout - Timeout value to use when starting pose. 334# 335# Starts the Palm OS Emulator, loads PRC files, and starts 336# a program. 337# 338sub start_pose 339{ 340 my $pose_exe = $_[0]; 341 my $sessionfile = $ENV{'EM_SESSION_FILE'}; 342 my $romfile = $ENV{'EM_ROM_FILE'}; 343 my $apps_load = $_[1]; 344 my $run_prog = $_[2]; 345 my $timeout = $_[3]; 346 my $stay_in_loop = 1; 347 my $address; 348 my $title; 349 my $form; 350 my $label_id; 351 my $num_objects; 352 my $i; 353 my $ii; 354 my $rc = 1; 355 356 my $pose_cmd = "$pose_exe "; 357 $pose_cmd .= " -psf $sessionfile "; 358 $pose_cmd .= "-load_apps $apps_load "; 359 $pose_cmd .= "-run_app $run_prog"; 360 361# It is more effective to use the -psf argument to 362# set these values. 363# 364# $pose_cmd .= -rom $romfile "; 365# $pose_cmd .= "-ram_size 8192 "; 366# $pose_cmd .= "-device PalmVx "; 367 368 &enter_func("start_pose"); 369 370 if ($global_debug) 371 { 372 &print_debug("\n"); 373 &print_debug("pose command is:\n"); 374 &print_debug(" $pose_cmd\n"); 375 } 376 377 print "\nLaunching pose...\n"; 378 system ("$pose_cmd &"); 379 380 # Give time for pose to get started... 381 # 382 for ($i=0; $i < $timeout; $i++) 383 { 384 $tmp = $i + 1; 385 print "$tmp\n"; 386 387 # Do not use pose_sleep here 388 # 389 sleep(1); 390 } 391 392 # Verify pose started successfully, and fail otherwise... 393 # 394 $rc = &verify_pose(5); 395 if ($rc != 0) 396 { 397 $stay_in_loop = 0; 398 } 399 else 400 { 401 # Sleep before opening the connection again, after testing in 402 # the verify_pose function. 403 # 404 pose_sleep(2); 405 &open_connection(1); 406 print "\nChecking if the appropriate window is on screen...\n"; 407 } 408 409 # Stop looping when the specified window has started. 410 # 411 for ($i=0; $i < $timeout && $stay_in_loop == 1; $i++) 412 { 413 $form = FrmGetActiveForm(); 414 $num_objects = FrmGetNumberOfObjects($form); 415 416 for $ii (0..$num_objects - 1) 417 { 418 my ($object_type) = FrmGetObjectType($form, $ii); 419 420 if ("$run_prog" eq "Quickword") 421 { 422 if ($object_type == frmTitleObj) 423 { 424 ($address, $title) = FrmGetTitle($form,); 425 426 # Display count and title. 427 # 428 $tmp = $i + 1; 429 print "$tmp - title is $title\n"; 430 431 if ("$title" eq "Quickword") 432 { 433 $stay_in_loop = 0; 434 $rc = 0; 435 last; 436 } 437 } 438 } 439 elsif ("$run_prog" eq "MiniCalc") 440 { 441 if ($object_type == frmLabelObj) 442 { 443 $label_id = FrmGetObjectId ($form, $ii); 444 ($address, $label) = FrmGetLabel($form, $label_id); 445 446 # Display count and label. 447 # 448 $tmp = $i + 1; 449 print "$tmp - label is $label\n"; 450 if ("$label" =~ "Solutions In Hand") 451 { 452 $stay_in_loop = 0; 453 $rc = 0; 454 last; 455 } 456 } 457 } 458 } 459 460 # Do not use pose_sleep here 461 # 462 sleep(1); 463 } 464 465 # Do not use pose_sleep here 466 # 467 sleep(1); 468 469 &leave_func("start_pose"); 470 return($rc); 471} 472 473# kill_pose 474# 475# Kills all pose processes 476# 477sub kill_pose 478{ 479 if ($global_debug) 480 { 481 print "Stopping pose process...\n"; 482 } 483 484 `pkill pose`; 485} 486 487# verify_pose 488# timeout - timeout to wait for pose 489# 490# Tries to do a connect/close to Pose to see if 491# it is working okay. 492# 493sub verify_pose 494{ 495 my $timeout = $_[0]; 496 my $rc = 0; 497 498 $rc = system("$em_script_home/verify_sane.pl $timeout"); 499 return $rc; 500} 501 502# db_export 503# dbname - Name of database to export 504# 505# Exports a palmdb file to /tmp 506# 507sub db_export 508{ 509 my $dbname = $_[0]; 510 511 &enter_func("db_export"); 512 print "\nExporting PDB file <$dbname> from pose\n"; 513 &pose_tap_pen(22, 20, 2); 514 &pose_tap_pen (15, 85, 2); 515 &enter_string($dbname, 1); 516 &pose_tap_pen (15, 126, 1); 517 &enter_string("/tmp/", 1); 518 &pose_tap_button("OK", 4); 519 &tap_applications(3); 520 print "Export of PDB file <$dbname> completed.\n"; 521 &leave_func("db_export"); 522} 523 524# 525# QUICKWORD SPECIFIC 526# 527 528# start_quickword 529# 530# Assuming pose was launched with the -run_app flag to launch 531# QuickWord on startup, this starts up QuickWord with the first 532# file in the list and turns off write-protect. 533# 534sub start_quickword 535{ 536 &enter_func("start_quickword"); 537 538 # This will open the first file in the list. 539 # Assuming this will always be the case. 540 # 541 &pose_tap_pen(20, 18, 1); 542 &quickword_press_write_protect(); 543 544 &leave_func("start_quickword"); 545} 546 547# quickword_press_write_protect 548# 549# Useful function for pressing the write protect button 550# to allow changes to be made. 551# 552sub quickword_press_write_protect 553{ 554 &enter_func("quickword_press_write_protect"); 555 556 my ($form) = FrmGetActiveForm(); 557 my ($num_objects) = FrmGetNumberOfObjects($form); 558 559 for $ii (0..$num_objects - 1) 560 { 561 my ($object_type) = FrmGetObjectType($form, $ii); 562 563 # The write protect button is the only frmGadgetObj 564 # on the QuickWord screen. 565 # 566 if ($object_type == frmGadgetObj) 567 { 568 my (%bounds) = FrmGetObjectBounds($form, $ii); 569 570 if ($global_debug) 571 { 572 &print_debug(" Found QuickWord WriteProtect button\n"); 573 &print_debug(" left = $bounds{left}\n"); 574 &print_debug(" right = $bounds{right}\n"); 575 &print_debug(" top = $bounds{top}\n"); 576 &print_debug(" bottom = $bounds{bottom}\n"); 577 } 578 579 # For some reason, the tapping of the write-protect button 580 # doesn't work unless you tap somewhere else first. 581 # 582 &pose_sleep(1); 583 &pose_tap_pen($bounds{left} + 2, $bounds{top} + 2, 1); 584 last; 585 } 586 } 587 588 &leave_func("quickword_press_write_protect"); 589} 590 591# quickword_find_replace 592# from_string - string to replace 593# to_string - string to replace with 594# 595# Uses QuickWord's find/replace utility to replace 596# one string with another. 597# 598sub quickword_find_replace 599{ 600 my $from_string = $_[0]; 601 my $to_string = $_[1]; 602 603 &enter_func("quickword_find_replace"); 604 605 # Move cursor to beginning... 606 # 607 &quickword_tap_at_top(1); 608 609 # Move to "Find" field: 610 # Triple-click to highlight all the text in the field, 611 # so it is removed when the string is entered... 612 # 613 &pose_tap_button("Find", 2); 614 &pose_tap_pen(50, 100, 0); 615 &pose_tap_pen(50, 100, 0); 616 &pose_tap_pen(50, 100, 1); 617 618 # sleep for 2 seconds to avoid double click after moving 619 # to replace field 620 # 621 &enter_string("$from_string", 2); 622 623 # Move to "Replace" field: 624 # Triple-click to highlight all the text in the field, 625 # so it is removed when the string is entered... 626 # 627 &pose_tap_pen(50, 120, 0); 628 &pose_tap_pen(50, 120, 0); 629 &pose_tap_pen(50, 120, 1); 630 &enter_string("$to_string", 1); 631 632 # Do find, then replace... 633 # 634 &pose_tap_button("Find", 1); 635 &pose_tap_button("Replace", 1); 636 &pose_tap_button("Cancel", 1); 637 638 &leave_func("quickword_find_replace"); 639} 640 641# quickword_tap_at_top 642# secs - seconds to sleep after the tap 643# 644# Tap's at the top of the QuickWord document. 645# 646sub quickword_tap_at_top 647{ 648 my $secs = $_[0]; 649 650 &enter_func("quickword_tap_at_top"); 651 652 # Sleep for a second to avoid any double-clicks 653 # from happening. 654 # 655 &pose_sleep(1); 656 657 &pose_tap_pen(0, 15, $secs); 658 &leave_func("quickword_tap_at_top"); 659} 660 661# Saves file and returns to the Application list. 662# 663sub close_quickword 664{ 665 &enter_func("close_quickword"); 666 667 &pose_tap_button("Done", 2); 668 &tap_applications(2); 669 670 &leave_func("close_quickword"); 671} 672 673# 674# MINICALC SPECIFIC 675# 676 677# start_minicalc 678# 679# Assuming pose was launched with the -run_app flag to launch 680# Minicalc on startup, this starts up Minicalc with the first 681# file in the list. 682# 683sub start_minicalc 684{ 685 &enter_func("start_minicalc"); 686 &pose_tap_button("OK", 1); 687 688 # For now just tap on the first spreadsheet. Add support 689 # for multiple sheets later. 690 # 691 &pose_tap_pen(10, 40, 5); 692 693 &leave_func("start_minicalc"); 694} 695 696# close_minicalc 697# 698# Returns to the Application list (no need to save). 699# 700sub close_minicalc 701{ 702 &enter_func("close_minicalc"); 703 &tap_applications(3); 704 &leave_func("close_minicalc"); 705} 706 707# minicalc_enter_cell 708# row - row to enter value, starting with 1 709# col - column to enter value, starting with 1 710# val - value to enter 711# 712# Only valid for minicalc. 713# 714# This only works if the val passed in has a '\n' at the 715# end. 716# 717sub minicalc_enter_cell 718{ 719 my $row = $_[0]; 720 my $col = $_[1]; 721 my $val = $_[2]; 722 my $i; 723 my $j; 724 725 &enter_func("minicalc_enter_cell"); 726 727 if ($global_debug) 728 { 729 &print_debug (" tapping to cell row=<$row> col=<$col>\n"); 730 } 731 732 # Tap pen on home button to start with row=1, col=A 733 # at top left. 734 # 735 pose_tap_pen(1, 1, 3); 736 737 # Now the cell should be in the top-left corner, 738 # so click there. However we must first click 739 # in another cell or pose doesn't acknowledge the 740 # click. 741 # 742 # pose_tap_pen(120, 95, 1); 743 # pose_tap_pen(21, 9, 1); 744 745 # Click the down button once for each row. 746 # Must pause 3 seconds each time, otherwise MiniCalc 747 # will not keep up. 748 # 749 for ($i=0; $i < $row; $i++) 750 { 751 if ($global_debug) 752 { 753 &print_debug (" Typing carrage return to go down\n"); 754 } 755 enter_string("\n", 1); 756 } 757 758 # Click the right button once for each col. 759 # Must pause 3 seconds each time, otherwise MiniCalc 760 # will not keep up. 761 # 762 for ($i=0; $i < $col; $i++) 763 { 764 if ($global_debug) 765 { 766 &print_debug (" Typing tab to go right\n"); 767 } 768 769 enter_string("\t", 1); 770 } 771 772 # enter string 773 # 774 &enter_string($val, 1); 775 776 &leave_func("minicalc_enter_cell"); 777} 778 779# 780# GENERIC UTILIIES (pose) 781# 782 783# tap_applications 784# secs - seconds to sleep after the tap 785# 786# taps pen on the Applications button. 787# 788sub tap_applications 789{ 790 my $secs = $_[0]; 791 792 &enter_func("tap_applications"); 793 794 &pose_tap_pen(15, 170, 1); 795 &pose_tap_pen(155, 10, 1); 796 &pose_tap_pen(155, 10, $secs); 797 798 &leave_func("tap_applications"); 799} 800 801# enter_string_at_location 802# x - x-location to enter string 803# y - y-location to enter string 804# in_string - string to enter 805# application - appliation (QUICKWORD or MINICALC) 806# 807# Enters a string at the specified x,y position. 808# 809sub enter_string_at_location 810{ 811 my $x_val = $_[0]; 812 my $y_val = $_[1]; 813 my $in_string = $_[2]; 814 my $application = $_[3]; 815 my $x; 816 my $y; 817 818 &enter_func("enter_string_at_location"); 819 820 $x = $x_val; 821 $y = $y_val; 822 823 if ($application eq "QUICKWORD") 824 { 825 # Allow users to specify TOP/BOTTOM/LEFT/RIGHT 826 # for QuickWord. 827 # 828 if ($y_val eq "TOP") 829 { 830 if ($global_debug) 831 { 832 &print_debug(" Converting TOP to 15\n"); 833 } 834 835 $y = 15; 836 } 837 if ($y_val eq "BOTTOM") 838 { 839 if ($global_debug) 840 { 841 &print_debug(" Converting BOTTOM to 144\n"); 842 } 843 844 $y = 144; 845 } 846 if ($x_val eq "LEFT") 847 { 848 if ($global_debug) 849 { 850 &print_debug(" Converting LEFT to 0\n"); 851 } 852 853 $x = 0; 854 } 855 if ($x_val eq "RIGHT") 856 { 857 if ($global_debug) 858 { 859 &print_debug(" Converting RIGHT to 152\n"); 860 } 861 862 $x = 152; 863 } 864 } 865 866 # Just to make sure the offset isn't outside the 867 # proper area. 868 # 869 if ($x >= 100) 870 { 871 $offset = -2; 872 } 873 else 874 { 875 $offset = 2; 876 } 877 878 &off_tap_pen($x, $y, $offset); 879 &enter_string($in_string, 1); 880 881 &leave_func("enter_string_at_location"); 882} 883 884# off_tap_pen 885# x - x-location to tap 886# y - y-location to tap 887# offset - x-offset to use for first tap. 888# 889# For some reason, pose does not register a single 890# pen tap if the last single pen tap was also 891# at the same x,y coordinate (even if the last tap 892# was a while ago). So this function does two 893# slightly different pen taps to ensure then pen 894# tap happens. 895# 896sub off_tap_pen 897{ 898 my $x = $_[0]; 899 my $y = $_[1]; 900 my $offset = $_[2]; 901 902 &enter_func("off_tap_pen"); 903 904 # sleep for 2 seconds to avoid double-click. 905 # 906 &pose_tap_pen_hard($x + $offset, $y, 2); 907 &pose_tap_pen_hard($x, $y, 1); 908 909 &leave_func("off_tap_pen"); 910} 911 912# enter_string 913# in_string - string to enter 914# secs - seconds to sleep after entering the string 915# 916# Enters a string 917# 918sub enter_string 919{ 920 my $in_string = $_[0]; 921 my $secs = $_[1]; 922 my $j; 923 924 &enter_func("enter_string"); 925 926 if ($global_debug) 927 { 928 # Display in_string so \n and \t values 929 # show up as normal ASCII. 930 # 931 if ($in_string eq "\n") 932 { 933 &print_debug(" Entering string : <\\n>\n"); 934 } 935 elsif ($in_string eq "\t") 936 { 937 &print_debug(" Entering string : <\\t>\n"); 938 } 939 else 940 { 941 &print_debug(" Entering string : <$in_string>\n"); 942 } 943 } 944 945 # Replace "\n" with real carrage returns. 946 # 947 my $string_val = $in_string; 948 $string_val =~ s#\\n#\n#g; 949 950 # Replace "\t" with a real tab. 951 # 952 $string_val =~ s#\\t#\t#g; 953 954 # Convert string to ASCII numeric values 955 # 956 my @array = unpack("C*", $string_val); 957 958 # Enter string one key at a time. 959 # 960 for ($j=0; $j <= $#array; $j++) 961 { 962 $queue_size = EnterKey($array[$j], 0, 0); 963 } 964 965 if ($secs > 0) 966 { 967 pose_sleep($secs); 968 } 969 970 &leave_func("enter_string"); 971} 972 973# 974# GENERIC UTILIIES (non pose) 975# 976 977# get_date_string 978# 979# Returns a timestampe string in yyyymmddHHMM format, where: 980# yyyy = year 981# mm = month 982# dd = day 983# HH = hour 984# MM = minute 985# 986# This sort of datestamp is used to create the output directory 987# names, so it used in various places. 988# 989sub get_date_string 990{ 991 my $cur_secs = time; 992 my @lu = localtime $cur_secs; 993 my $lu_secs = $lu[1]; 994 my $lu_hours = $lu[2]; 995 my $lu_day = $lu[3]; 996 my $lu_mon = $lu[4] + 1; 997 my $lu_year = $lu[5] + 1900; 998 my $lu_str = $lu_year; 999 1000 if ($lu_mon < 10) 1001 { 1002 $lu_str .= "0"; 1003 } 1004 $lu_str .= $lu_mon; 1005 1006 if ($lu_day < 10) 1007 { 1008 $lu_str .= "0"; 1009 } 1010 $lu_str .= $lu_day; 1011 1012 if ($lu_hours < 10) 1013 { 1014 $lu_str .= "0"; 1015 } 1016 $lu_str .= $lu_hours; 1017 1018 if ($lu_secs < 10) 1019 { 1020 $lu_str .= "0"; 1021 } 1022 $lu_str .= $lu_secs; 1023 1024 return $lu_str; 1025} 1026 1027# 1028# DEBUG FUNCTIONS - Wrapper functions 1029# 1030 1031# pose_tap_pen 1032# x - x-position of pen tap 1033# y - y-position of pen tap 1034# secs - seconds to sleep after the tap 1035# 1036# Taps pen at specified position and displays debug info 1037# 1038sub pose_tap_pen 1039{ 1040 my $x = $_[0]; 1041 my $y = $_[1]; 1042 my $secs = $_[2]; 1043 1044 if ($global_debug) 1045 { 1046 &print_debug(" Tapping pen at : $x,$y\n"); 1047 } 1048 1049 TapPen($x, $y); 1050 1051 if ($secs > 0) 1052 { 1053 pose_sleep($secs); 1054 } 1055} 1056 1057# pose_tap_pen_hard 1058# x - x-position of pen tap 1059# y - y-position of pen tap 1060# secs - seconds to sleep after the tap 1061# 1062# Taps pen at specified position and displays debug info 1063# This function works more effectively in situations where 1064# pose_tap_pen is flakey. This function is not good for 1065# double/triple click situations since it is slow. 1066# 1067sub pose_tap_pen_hard 1068{ 1069 my $x = $_[0]; 1070 my $y = $_[1]; 1071 my $secs = $_[2]; 1072 1073 if ($global_debug) 1074 { 1075 &print_debug(" Tapping pen hard at : $x,$y\n"); 1076 } 1077 1078 `$qa_script_home/tappen.pl $x $y`; 1079 1080 if ($secs > 0) 1081 { 1082 pose_sleep($secs); 1083 } 1084} 1085 1086# pose_tap_button 1087# button - button to press 1088# secs - seconds to sleep after the button press 1089# 1090# Presses specified button and displays debug info 1091# 1092sub pose_tap_button 1093{ 1094 my $button = $_[0]; 1095 my $secs = $_[1]; 1096 1097 if ($global_debug) 1098 { 1099 &print_debug(" Tapping button : $button\n"); 1100 } 1101 1102 TapButton($button); 1103 1104 if ($secs > 0) 1105 { 1106 pose_sleep($secs); 1107 } 1108} 1109 1110# pose_sleep 1111# secs - seconds to sleep 1112# 1113# Sleeps the specified amount of time and displays debug info 1114# 1115sub pose_sleep 1116{ 1117 my $secs = $_[0]; 1118 1119 if ($global_debug) 1120 { 1121 &print_debug(" Sleeping : $secs seconds\n"); 1122 } 1123 1124 sleep($secs); 1125} 1126 1127# enter_func 1128# func - function name 1129# 1130# Displays debug info about entering specified function. 1131# 1132sub enter_func 1133{ 1134 my $func = $_[0]; 1135 1136 if ($global_debug) 1137 { 1138 &print_debug("Function enter : $func\n"); 1139 } 1140} 1141 1142# leave_func 1143# func - function name 1144# 1145# Displays debug info about leaving specified function. 1146# 1147sub leave_func 1148{ 1149 my $func = $_[0]; 1150 1151 if ($global_debug) 1152 { 1153 &print_debug("Function exit : $func\n"); 1154 } 1155} 1156 1157# print_debug 1158# string - string to print 1159# 1160# Displays debug message with a # at the beginning of the line. 1161# 1162sub print_debug 1163{ 1164 my $string = $_[0]; 1165 1166 print "# $string"; 1167} 1168 11691; 1170 1171