testautomation/global/system/includes/status.inc

   1 'encoding UTF-8  Do not remove or change this line!
   2 '**************************************************************************
   3 '* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 '*
   5 '* Copyright 2008 by Sun Microsystems, Inc.
   6 '*
   7 '* OpenOffice.org - a multi-platform office productivity suite
   8 '*
   9 '* $RCSfile: status.inc,v $
  10 '*
  11 '* $Revision: 1.1 $
  12 '*
  13 '* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $
  14 '*
  15 '* This file is part of OpenOffice.org.
  16 '*
  17 '* OpenOffice.org is free software: you can redistribute it and/or modify
  18 '* it under the terms of the GNU Lesser General Public License version 3
  19 '* only, as published by the Free Software Foundation.
  20 '*
  21 '* OpenOffice.org is distributed in the hope that it will be useful,
  22 '* but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 '* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 '* GNU Lesser General Public License version 3 for more details
  25 '* (a copy is included in the LICENSE file that accompanied this code).
  26 '*
  27 '* You should have received a copy of the GNU Lesser General Public License
  28 '* version 3 along with OpenOffice.org.  If not, see
  29 '* <http://www.openoffice.org/license.html>
  30 '* for a copy of the LGPLv3 License.
  31 '*
  32 '/************************************************************************
  33 '*
  34 '* owner : thorsten.bosbach@sun.com
  35 '*
  36 '* short description : Routines for the status page feature
  37 '*
  38 '\*****************************************************************************************
  39
  40 sub hStatusIn ( sTestAppArea as String, sTestname as String, optional sName as String )
  41     '///hStatusIn : initilize variables before the teststart
  42     '///  input  : sTestAppArea => name of the application, to where the test is bound in status database -> gTestAppArea
  43     '              sTestname    => name of the test (converted to LOWERCASE in this sub!) -> gTestName
  44     '///+ output : gStatusDuration => starttime of the test
  45     '///+_       : gTestname    => global name of the test
  46     '///+_       : gTestAppArea => global name of the tested application as defined in status database
  47     '///+_       : gTestDate    => global start date of the test ( yyyy-mm-dd )
  48     '///+_       : gTestTime    => global start time of the test
  49     ' DEPRECATED:
  50     '         sNname       => DEPRECATED just kept for compatibility
  51
  52     dim bOverRide as boolean
  53
  54     bOverRide = false
  55     gStatusDuration = now ()                    '(1) used in hStatusOut
  56                           ' temporarly misused to set the start Date and Time!
  57
  58     ' Always needed for crashreporter test hint
  59     gTestName = lcase (sTestname)               '(2)
  60
  61     ' -------------- EXIT condition ----------------------
  62     if (NOT isStatusEnabled()) then
  63         exit sub
  64     end if
  65
  66     gTestAppArea = lcase (sTestAppArea)         '(3)
  67
  68     gTestDate = convertDateToDatabase (gStatusDuration)  '(4)
  69     gTestTime = convertTimeToDatabase (gStatusDuration)  '(5)
  70
  71     ListAllDelete(glsStatusPage())
  72     gErrorSum = getErrorCount()      ' not 0! if you run 2-times status in/out in one bas-file!
  73     gWarningSum = getWarningCount()
  74     gQaErrorSum = getQaErrorCount()
  75
  76     ' make sure we have everything to update the status-Database.
  77     gDatabasePath = getDatabasePath(privateDatabasePath)
  78     if ("" = gDatabasePath) then
  79         'Disable statusfeature, because the public filespace is not available.
  80         gStatusDatabase = FALSE
  81         printlog "**  Status will be written to     : DISABLED"
  82     else
  83         printlog "**  Status will be written to     : " + gDatabasePath
  84     endif
  85     printlog     "**  Test environment preparation  : " + wielange(gTestcaseStart)
  86 end sub
  87
  88 sub hStatusOut ( optional NoKill as Boolean )
  89     '///hStatusOut : last output for the status-page feature
  90     '///+ -> create the duration value for the test and call the routine to write the data into the database
  91
  92     Dim sLocalTestDuration as string
  93
  94     printlog  ""
  95     printlog  "**  All tests finished."
  96     sLocalTestDuration = WieLange( gStatusDuration )
  97     gTestcaseStart= now ()    ' get time for writing status to database
  98
  99     ' -------------- EXIT condition ----------------------
 100     ' don't record status if outside of status database
 101     if (NOT isStatusEnabled()) then
 102         Printlog "Date: " + Date() + "; Time: " + Time() + "; Duration: " + WieLange ( gStatusDuration )
 103         exit sub
 104     end if
 105
 106     if (""=gTestName) then
 107         warnlog "status.inc::hStatusOut: You forgot to call hStatusIn(''Application'',''FileName.bas'')"
 108     else
 109         printlog  "**  Start generating quaste database files."
 110         hStatusWriteOutputFirstFile() ' write again, to have correct duration written.
 111         hStatusWriteOutput()
 112         printlog "**  Creating status duration    : " + wielange(gTestcaseStart)
 113     end if
 114
 115     PrintLog Chr(13) + "* - End of the test - *"
 116     Printlog "Date : " + Date() + "   Time: " + Time()
 117     Printlog "Duration : " + sLocalTestDuration
 118 end sub
 119
 120 sub hStatusAddTestcase()
 121     ' called from master.inc::TestExit() after every testcase
 122     ' add to list for second file : testresult table / glsStatusPage()
 123     ' reset gErrorSum, gWarningSum
 124     dim sTestcaseDuration as string
 125     dim sTestcaseStart as string
 126     Dim sTCname as String
 127     Dim iCut as Integer
 128     dim iErrorCount as integer
 129     dim sErrorList() as string
 130     dim iQaErrorCount as integer
 131     dim sQaErrorList() as string
 132     dim iWarningCount as integer
 133     dim sWarningList() as string
 134     Dim sOutput as String
 135     dim iAllErrorCount as integer
 136     dim sAllErrorList(42000) as string
 137     dim i, x as integer
 138     dim iErrorLevel as integer
 139     dim sErrorString(4) as string
 140
 141     '///The entries in the list are ( seperated by TAB ) :
 142     '///+ testcase name => name of the current testcase in the running test
 143     '///+ errors => only the errors for the current testcase
 144     '///+ warnings => only the warnings for the current testcase
 145     '///+ duration => the duration of the testcase
 146
 147     sTestcaseDuration = wielange(gTestcaseStart, 1)     '(2)
 148     sTestcaseStart    = convertDateToDatabase(gTestcaseStart) + " " + convertTimeToDatabase(gTestcaseStart) ' TODO: ask HDE/TBO
 149
 150     sTCname = GetTestcaseName  ' testtool basic command
 151         iCut = Instr ( sTCname, "(" )
 152         if (iCut <> 0) then
 153             sTCname = Left ( sTCname, iCut - 1 )
 154         endif
 155         sTCname = Trim ( sTCname )                      '(1)
 156     iErrorCount = getErrorCount() - gErrorSum               ' only the errors in a testcase
 157     iWarningCount = getWarningCount() - gWarningSum         ' only the warnings in a testcase
 158     iQaErrorCount = getQaErrorCount() - gQaErrorSum         ' only the qaErrors in a testcase
 159
 160     iAllErrorCount = iErrorCount + iWarningCount + iQaErrorCount
 161     if (iAllErrorCount > 0) then
 162         x=1
 163         sWarningList() = getWarningList()
 164         for i = (GetWarningCount()+1-iWarningCount) to GetWarningCount()
 165             sAllErrorList(x) = sWarningList(i)
 166 'd                printlog "++ " + sAllErrorList(x)
 167             inc(x)
 168         next i
 169         sErrorList() = getErrorList()
 170         for i = (GetErrorCount()+1-iErrorCount) to GetErrorCount()
 171             sAllErrorList(x) = sErrorList(i)
 172 'd                printlog "++ " + sAllErrorList(x)
 173             inc(x)
 174         next i
 175         sQaErrorList() = getQaErrorList()
 176         for i = (getQaErrorCount()+1-iQaErrorCount) to getQaErrorCount()
 177             sAllErrorList(x) = sQaErrorList(i)
 178 'd                printlog "++ " + sAllErrorList(x)
 179             inc(x)
 180         next i
 181     else
 182         sAllErrorList(0) = "0;0;0;0"
 183     endif
 184
 185     ' generate status line for testcase and append to global array
 186     '/// iErrorLevel: 0: no faults; 1: Warning; 2: Error; 3: qaError ///'
 187     iErrorLevel = -1
 188 'D    printlog "Iall: " + iAllErrorCount + " W:" + iWarningCount + " E: " + iErrorCount
 189     for i = 0 to iAllErrorCount
 190         select case i
 191             case 0: if (0 = iAllErrorCount) then          ' no errors at all
 192                         iErrorLevel = 0
 193                     endif
 194             case 1 to iWarningCount: iErrorLevel = 1      'warnings
 195             case (iWarningCount +1) to (iWarningCount + iErrorCount): iErrorLevel = 2 ' Errors
 196             case (iWarningCount + iErrorCount +1) to (iWarningCount + iErrorCount + iQaErrorCount): iErrorLevel = 3 ' qaErrors
 197         end select
 198         if (iErrorLevel > -1) then
 199 'd            printlog " " + i + " -------------"
 200 'd            printlog "'" + sAllErrorList(i) + "'"
 201             sGetErrorStringFields(sAllErrorList(i), sErrorString())
 202 'd            printlog " -------------"
 203             sOutput =          sTCname _
 204                     + Chr(9) + sTestcaseDuration _
 205                     + Chr(9) + iErrorLevel _
 206                     + Chr(9) + fRemoveLineBreaks(sErrorString(4)) _
 207                     + Chr(9) + sErrorString(2) _
 208                     + Chr(9) + trim(sErrorString(3)) _
 209                     + Chr(9) + fgetFileName(sErrorString(1)) _
 210                     + Chr(9) 'Description (4)_ 'Line (2)_ 'CVSversion (3)_ 'Filename (1)
 211             if (sTCname <> "") then
 212                 ListAppend (glsStatusPage(), sOutput)
 213 'd            printlog sOutput
 214             else
 215                 qaErrorlog "please try not to call a testcase from a testcase #116584#"
 216             endif
 217         endif
 218     next i
 219
 220     ' to set the variables to the current numbers
 221     gErrorSum = getErrorCount()
 222     gQaErrorSum = getQaErrorCount()
 223     gWarningSum = getWarningCount()
 224 end sub
 225
 226 sub hStatusWriteOutputFirstFile ()
 227     ' called from hStatusOut and hStatusIn
 228     Dim sPlat as String
 229     Dim sOutFile as String
 230     Dim sOutFileTemp as String
 231     Dim sBuildHisPath as string
 232     Dim sResultPath as string    ' location where to write the files for status to
 233     Dim i as integer
 234     dim j as Integer
 235     dim lTestrun(50) as string
 236     dim sVersionMajor as string
 237     dim sVersionMinor as string
 238     dim sVersionBuilID as string
 239     dim sDebugInfo as string
 240     dim sTemp as string
 241     dim sFileName as string
 242     dim slVersion() as string
 243     dim ilVersion as integer
 244     dim sVersionCWS as string
 245     dim iPosA as integer
 246     dim iPosB as integer
 247     dim bError as boolean
 248     dim sTestDuration as string
 249     dim sSource as string
 250     dim sProduct as string
 251     dim sUsername as string
 252
 253     '///hStatusWriteOutputFirstFile : output routine for status page of our testscripts
 254     '///The entries in the list are ( seperated by NEWLINE ) :
 255     '///+ 1 major => major number of full buildID of StarOffice ( e.g. '642' )
 256     '///+ 2 minor => minor number of full buildID of StarOffice ( e.g.'L' )
 257     '///+ 3 buildID => only the buildID of full buildID of StarOffice ( e.g.'7733' )
 258     '///+ 4 date ( gTestDate ) time ( gTestTime ) => fix date when the test started
 259     '///+ 5 platform => short cut for platform
 260     '///+ 6 machine name => name of the PC or UNIX-machine where the test is running
 261     '///+ 7 user name => E-mail adress of user
 262     '///+ 8 fileformat => version belonging to this spec
 263     '///+ 9 language => language of the office
 264     '///+ 10 test name => name of the test ( e.g. first.bas )
 265     '///+ 11 test application area (gApplication) => which application is tested
 266     '///+ 12 test duration => Hours:Minutes:Seconds ( e.g.'01:20:33' )
 267     '///+ 13 cws name => if it is the master: 'Master' else the name of the childworkspace
 268     '///+ 14 source tree =>
 269     '///+ 15 product =>
 270     '///+ 16 builder =>
 271     '///+ 17 checksum =>
 272     '///+ data =>
 273
 274     if ("unx" = gPlatgroup) then                                  '(5)
 275         sPlat = gPlatform
 276     else
 277         sPlat = "win"
 278     end if
 279
 280    slVersion() = Split(gProductName, " ")                         '(15)
 281    sProduct = slVersion(0)
 282
 283     ' major is from start to 'm'
 284     iPosA = 1
 285     iPosB = instr(gVersionsnummer, "m")
 286     if (iPosB = 0) then ' there is no minor
 287         iPosB = instr(gVersionsnummer, "(")
 288     endif
 289     sVersionMajor = Mid(gVersionsnummer, iPosA, (iPosB-iPosA))      '(1) Major
 290     iPosA = iPosB
 291     iPosB = instr(gVersionsnummer, "(")
 292     sVersionMinor  = Mid(gVersionsnummer, iPosA, iPosB-iPosA)        '(2) Minor
 293     iPosA = instr(gVersionsnummer, ":") + 1
 294     iPosB = instr(gVersionsnummer, ")")
 295     sVersionBuilID = Mid(gVersionsnummer, iPosA, iPosB-iPosA)        '(3) Build
 296     if gCWS then
 297         iPosA = instr(iPosB, gVersionsnummer, ":") + 1
 298         iPosB = instr(iPosA, gVersionsnummer, "]")
 299         sVersionCWS = Mid(gVersionsnummer, iPosA, iPosB-iPosA)       '(13) CWS
 300     else
 301         sVersionCWS = "Master"
 302     endif
 303     sSource = left(gMajor,3)                                       '(14) Source tree
 304
 305     ' for MSC calculation of test duration hh:mm
 306     sTestDuration = wielange(gStatusDuration, 1)                  '(12)
 307
 308     if ("" = gReturnAddress) then                               '(7)
 309         if ("" = gLocalStatusDatabase) then
 310             warnlog "Please set an e-mail adress for your crashreports in TestTool: Extra->Settings->Crashreport:EMail, it will also be used to send you notifications in case of problems submitting the status of the test to the database (quaste)."
 311         endif
 312         sUsername = gUser
 313     else
 314         sUsername = gReturnAddress
 315     endif
 316
 317     ListAppend ( lTestrun(), "fileformat=0.2"             )
 318     ListAppend ( lTestrun(), "product=" + sProduct        )
 319     ListAppend ( lTestrun(), "sourcetree=" + sSource      )
 320     ListAppend ( lTestrun(), "major=" + sVersionMajor     )
 321     ListAppend ( lTestrun(), "minor=" + sVersionMinor     )
 322     ListAppend ( lTestrun(), "buildid=" + sVersionBuilID  )
 323     ListAppend ( lTestrun(), "oooorigin=" + "")
 324     ListAppend ( lTestrun(), "startdate=" + gTestDate + " " + gTestTime)         '(4)  ' generated in hStatusIn
 325     ListAppend ( lTestrun(), "duration=" + sTestDuration  )
 326     ListAppend ( lTestrun(), "platform=" + sPlat          )
 327     ListAppend ( lTestrun(), "hostname=" + gPCName        )                        '(6)
 328     ListAppend ( lTestrun(), "username=" + sUsername      )                        '(7)
 329     ListAppend ( lTestrun(), "application=" + gTestAppArea)                        '(11) ' generated in hStatusIn
 330     ListAppend ( lTestrun(), "testname=" + gTestName      )                        '(10) ' generated in hStatusIn
 331     ListAppend ( lTestrun(), "cws=" + sVersionCWS         )
 332     ListAppend ( lTestrun(), "ooolanguage=" + iSprache    )                        '(9)
 333     ListAppend ( lTestrun(), "checksum=" + "")
 334 '    ListAppend ( lTestrun(), "data=" + )
 335
 336     ' files are created at (convertPath'ed):
 337     sResultPath = convertPath(gDatabasePath)
 338     sFileName   = fGetQuasteFileName()
 339     sOutFile    = sResultPath + sFileName
 340
 341     ' TODO: make sure location is writeable! with file 'sOutFile'!!!
 342
 343     ' delete old files
 344     for i = 1 to 4
 345         sOutFileTemp = sOutFile+i+".txt"
 346         if (FileExists(sOutFileTemp)) then
 347 '            printlog sOutFileTemp
 348             kill sOutFileTemp
 349             if (dir(sOutFileTemp) <> "") then
 350                 warnLog "OLD File can't get deleted: " + sOutFileTemp
 351             endif
 352         end if
 353     next i
 354
 355     ListWrite (lTestrun(), sOutFile+"1.txt")
 356 end sub
 357
 358 function fGetQuasteFileName() as string
 359     dim sPlat as string
 360     dim sName as string
 361
 362     if ("unx" = gPlatgroup) then
 363         sPlat = gPlatform
 364     else
 365         sPlat = "win"
 366     end if
 367
 368     sName = lcase(sPlat + gUser + gPCname + Left(gTestname, Len(gTestname)-4) + "-" + iSprache + "-" )
 369     fGetQuasteFileName = removeCharacter(sName,46)  ' remove '.' dots from filename, would result in errors on uploading file.
 370 end function
 371
 372 sub hStatusWriteOutput (optional NoKill as Boolean)
 373     ' called from hStatusOut
 374     Dim sPlat as String
 375     Dim sOutFile as String
 376     Dim sOutFileTemp as String
 377     Dim sBuildHisPath as string
 378     Dim sResultPath as string    ' location where to write the files for status to
 379     Dim i as integer
 380     dim j as Integer
 381     dim sDebugInfo as string
 382     dim sTemp as string
 383     dim sFileName as string
 384     dim bError as boolean
 385     dim sTestDuration as string
 386
 387     if ("unx" = gPlatgroup) then                                  '(5)
 388         sPlat = gPlatform
 389     else
 390         sPlat = "win"
 391     end if
 392
 393     ' files are created at (convertPath'ed):
 394     sResultPath = convertPath(gDatabasePath)
 395     sFileName   = fGetQuasteFileName()
 396     sOutFile    = sResultPath + sFileName
 397
 398     for i = 1 to ListCount(glsStatusPage())
 399         glsStatusPage(i) = "data=" + glsStatusPage(i)
 400     next i
 401     'write 'testresult'
 402     ListWriteAppend (glsStatusPage(), sOutFile+"1.txt")
 403     if (dir(sOutFile+"1.txt") = "") then warnlog "File wasn't created: " + sOutFile+"1.txt"
 404
 405     ' debug
 406 ' from now on the status routines are not executed, because i use tescases for displaying debug information, that should not get recorded
 407 gTestName="" '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 408
 409     ' call php-script to get file into the database
 410     bError = StatusIntoDatabase (sFileName, sPlat, FALSE, gDatabasePath)
 411     if bError then
 412         exit sub ' -> on error no file get's deleted!
 413     end if
 414
 415     ' wait until result-file got created; after 3 minutes cancel wait!
 416     sOutFileTemp = sOutFile+"3.txt"
 417     i = 0
 418     listAllDelete(glsStatusPage())
 419     while (("" = dir(sOutFileTemp)) AND (i < 18))
 420         sleep 10
 421         inc (i)
 422     wend
 423     bError = True
 424     if (i = 18) then ' big database error; resultfile wasn't created
 425         warnlog "Status Write Error! (TimeOut waiting for webservice result)" +chr(13)+ "Email is send to: " + gReturnAddress
 426     else
 427         ListRead(glsStatusPage(), sOutFileTemp)   '3
 428         i = ListCount(glsStatusPage())
 429         if (1 = i) then
 430             if (glsStatusPage(1) <> "OK") then
 431                 warnlog "Error in writing status to database (<> OK): '" + glsStatusPage(1) + "'" +chr(13)+ "Email is send to: " + gReturnAddress
 432             else
 433                 if (gStatusFeatureLevel < 2) then
 434                     printlog " * - Status successfully written into database - * "
 435                 else
 436                     printlog " * - Status file successfully created - * "
 437                 endif
 438                 bError = False
 439             endif
 440         else
 441             warnlog "Error in writing status to database (<> 1 line)" +chr(13)+ "Email is send to: " + gReturnAddress
 442         endif
 443     endif
 444
 445     ' delete files
 446     if (bError=FALSE) then
 447             sOutFileTemp = sOutFile+"1.txt"
 448                 try
 449                     if (dir(sOutFileTemp) <> "") then
 450                             kill ( sOutFileTemp )
 451                     end if
 452                 catch
 453                 endcatch
 454             if (dir (sOutFileTemp) <> "") then
 455                 warnlog "File wasn't deleted: " + sOutFileTemp
 456             endif
 457     endif
 458     sOutFileTemp = sOutFile+"3.txt"
 459         try
 460             if (dir(sOutFileTemp) <> "") then
 461                     kill ( sOutFileTemp )
 462             end if
 463         catch
 464         endcatch
 465     if (dir (sOutFileTemp) <> "") then
 466         warnlog "File wasn't deleted: " + sOutFileTemp
 467     endif
 468     sOutFileTemp = sOutFile+"4.htm"
 469         try
 470             if (dir(sOutFileTemp) <> "") then
 471                     kill ( sOutFileTemp )
 472             end if
 473         catch
 474         endcatch
 475     if (dir (sOutFileTemp) <> "") then
 476         warnlog "File wasn't deleted: " + sOutFileTemp
 477     endif
 478     ListAllDelete (glsStatusPage())   ' delete the list, because if you want to use hStatusIn twice or more
 479 end sub
 480
 481
 482 function StatusIntoDatabase (sFile as String, sPlat as String, NoKill as Boolean, sPath as string) as boolean
 483     dim sSource as string
 484     dim sDestination as string
 485     dim i as integer
 486
 487     '///StatusIntoDatabase : write the collected data into the database
 488     if (gStatusFeatureLevel < 2) then
 489         ' Automatical entry into database
 490         printlog "**  Calling webservice to grab status file."
 491         StatusIntoDatabase = getWebPage (sPath, sPath+sFile+"4.htm", sPlat, privateDatabaseServerIP, privateDatabaseServerPath + sFile + "1.txt")
 492         printlog "**  Waiting for result from webservice."
 493     else
 494         ' preparation for manual entry into database
 495         StatusIntoDatabase = FALSE
 496         'create 3. file with OK :-)
 497         sSource = convertPath(sPath)
 498         sDestination = ""
 499         if gCWS then
 500             ' if we have a CWS, generate a string of the CWS name
 501             i = instr(gVersionsnummer, "[")
 502             if i > 0 then
 503                 sDestination = Mid(gVersionsnummer, i+1)
 504                 i = len(sDestination)
 505                 sDestination = left(sDestination, i-1)
 506                 i = inStr(sDestination, ":")
 507                 mid(sDestination, i, 1, "_")
 508              endif
 509         endif
 510         sDestination = sSource + lCase(gMajor + gMinor + sDestination)
 511         TextInDatei("OK", sSource+sFile+"3.txt")
 512         'move other files to directory, because standard is to delele successfull submitted data
 513         if (dir(sDestination, 16) = "") then ' doesn't exist
 514             MkDir (sDestination)
 515             if (dir(sDestination, 16) = "") then ' doesn't exist
 516                 warnlog "Database directory can't get created: '" + sDestination + "'"
 517             else
 518                 printlog "Database directory created: '" + sDestination + "'"
 519             endif
 520         endif
 521         sDestination = sDestination + gPathSigne
 522         filecopy(sSource+sFile+"1.txt", sDestination+sFile+"1.txt")
 523     endif
 524 end function
 525
 526 function getWebPage (sPath as string, sResult as String, sPlat as String, sHost as string, sPage as string) as boolean
 527     dim iShellReturn as integer
 528
 529     if (sPlat = "win") then
 530         sPlat = "exe"
 531     endif
 532
 533     try
 534             'httpSetProxy(Host, Port)
 535             iShellReturn = httpSend(sHost, sPage, 80, sResult)
 536     catch
 537         iShellReturn = 99
 538     endcatch
 539         ' when using internal httpSend, iShellReturn contains http status numbers: 200 means: ok
 540         if (iShellReturn = 99) then
 541             printlog "Writing status to database with internal httpsend command failed: " + iShellReturn + chr(13) + sHost+sPage + chr(13) + sResult
 542         else
 543           if (iShellReturn <> 200) then
 544             warnlog "Writing status to database with internal httpsend command failed: " + iShellReturn + chr(13) + sHost+sPage
 545           endif
 546         endif
 547 end function
 548
 549
 550 testcase tDebugInfoMysql (sTemp as string)
 551 ' to show the debuginfo folded in a testcase (if nokill = true)
 552     dim fTemp(900) as string
 553
 554     fTemp(0)=0
 555     printlog stemp
 556     try
 557         ListRead (fTemp(), sTemp)
 558         for i=1 to ListCount (fTemp())
 559             if (fTemp(i) <> "") then printlog fTemp(i)
 560         next i
 561     catch
 562     endcatch
 563 endcase
 564
 565 function isStatusEnabled() as boolean
 566     '/// enable status only when: ///'
 567     '///+ basedirectory is on server (variable is set to 1 gStatusFeatureLevel) ///'
 568     isStatusEnabled = gStatusDatabase
 569 end function
 570
 571 function convertDateToDatabase(byVal inDate as Date) as string
 572     Dim IsoData$, y$, m$, d$
 573
 574     IsoData$ = CDateToIso (inDate)
 575     y$ = left$( IsoData$, 4 )
 576     m$ = mid$( IsoData$, 5, 2 )
 577     d$ = right$( IsoData$, 2 )
 578     convertDateToDatabase = y$ + "-" + m$ + "-" + d$
 579 end function
 580
 581 function convertTimeToDatabase(byVal inTime as Date) as string
 582     dim iSpace as integer
 583
 584     iSpace = inStr(inTime, " ")
 585     if (iSpace > 0) then
 586         inTime = right(inTime, len(inTime) - iSpace)
 587     endif
 588     if (iSystemSprache = 1) then
 589         try
 590             convertTimeToDatabase = TimeValue(inTime)
 591         catch
 592             qaErrorLog "global::system::inc::status.inc::convertTimeToDatabase; looking for root cause: 'Data type mismatch'; Input: '" + inTime + "'"
 593         endcatch
 594     else
 595         convertTimeToDatabase = Format (inTime, "hh:mm:ss")
 596     endif
 597 end function
 598
 599 function getDatabasePath(sSubDirectory as string) as string
 600     dim sPath as string
 601     dim sPathSeed as string
 602
 603     if gStatusFeatureLevel = 2 then
 604         ' write it below 'errorlog' directory
 605         sPath = convertPath(GetIniValue (gTesttoolIni, gTTProfileName , "LogBaseDir"))
 606         if (right(sPath, 1) <> gPathSigne) then
 607             sPath = sPath + gPathSigne
 608         end if
 609         getDatabasePath = sPath
 610         gLocalStatusDatabase = sPath
 611     else
 612         ' assumption: the only supported testcases are always on local fileserver -> gTestToolPath provides a valid volume !
 613         if (gStatusFeatureLevel = 1) then
 614             ' global filespace for database is defined in testtoolrc
 615             sPath = gLocalStatusDatabase + gPathSigne
 616             sPath = fRemoveDoubleCharacter(sPath, gPathSigne)
 617         else
 618             'gStatusFeatureLevel = 0
 619             ' status database server is global defined
 620             sPath = gTestToolPath + gPathSigne + sSubDirectory
 621             sPath = convertPath(sPath)
 622             sPath = fRemoveDoubleCharacter(sPath, gPathSigne)
 623             sPath = fRelativeToAbsolutePath(sPath)
 624             sPath = fRemoveDoubleCharacter(sPath+ gPathSigne, gPathSigne)
 625         endif
 626         if (NOT fileExists(sPath + "quaste.txt")) then
 627             qaErrorLog "The public file space seems to be wrong: "  + sPath
 628         endif
 629     endif
 630     getDatabasePath = sPath
 631 end function
 632
 633 sub sGetErrorStringFields(sIn as string, sOut() as string)
 634     '/// put semicolon seperated string into an array ///'
 635     '/// only used on every line from returnvalue of get*List() ///'
 636     dim sTemp(3) as string
 637     dim sTemp2() as string
 638     dim i as integer
 639     if ("" = sIn) then     ' workaround for i23697 split() returns wrong value on empty string
 640         for i=0 to 3
 641             sTemp(i) = ""
 642         next i
 643     else
 644         sTemp() = Split(sIn, ";")
 645     endif
 646     if ((uBound(sTemp())+1) <>  uBound(sOut())) then
 647         for i = 1 to (uBound(sOut()) -1)
 648              sOut(i) =  sTemp(i-1)
 649         next i
 650         redim sTemp2(uBound(sTemp()) - uBound(sOut())+1) as string
 651         for i = (uBound(sOut())-1) to uBound(sTemp())
 652              sTemp2(i-(uBound(sOut())-1)) = sTemp(i)
 653         next i
 654         sOut(uBound(sOut())) = join(sTemp2(), ":")
 655     else
 656         for i = 0 to uBound(sTemp())
 657             sOut(i+1) = sTemp(i)
 658         next i
 659     endif
 660
 661 '    for i = 0 to uBound(sTemp())
 662 'd        printlog "" + i + ": " + sTemp(i)
 663 '    next i
 664 end sub
 665
 666 function fRemoveLineBreaks(sIn as string) as string
 667     '/// Clean string from reserved characters and remove linebreaks ///'
 668     '/// only used for errormessage in third field from get*List() ///'
 669     dim sLocal as string
 670     dim x as integer
 671     dim iCharacters(7) as integer
 672     iCharacters(1) = 9  ' TAB  because it is field seperator in data file
 673     iCharacters(2) = 10 ' LF   because no linebreak is allowed in data file
 674     iCharacters(3) = 13 ' CR   because no linebreak is allowed in data file
 675     iCharacters(4) = 39 ' '    because is string delemiter for mysql
 676     iCharacters(5) = 8216 ' '  because is string delemiter for mysql
 677     iCharacters(6) = 8217 ' '  because is string delemiter for mysql
 678     iCharacters(7) = 92 '\  '  because it is escape code
 679
 680     sLocal = sIn
 681
 682     for x = 1 to 7
 683         sLocal = removeCharacter(sLocal,iCharacters(x))
 684     next x
 685
 686     fRemoveLineBreaks = sLocal
 687 end function
 688
 689 function removeCharacter(sIn as string, iCharacter as integer) as string
 690     dim sLocal as string
 691     dim sArray() as string
 692     dim i as integer
 693     dim iBound as integer
 694     sLocal = sIn
 695         if ("" = sLocal) then     ' workaround for i23697 split() returns wrong value on empty string
 696 '            for i=0 to 3
 697 '                sTemp(i) = ""
 698 '            next i
 699         else
 700             sArray() = split(sLocal, chr(iCharacter))
 701         endif
 702         sLocal = ""
 703         iBound = uBound(sArray())
 704 '        if (iBound > 0) then printlog "########## " + i + " - " + iCharacters(x) + " ++++ " + iBound
 705         for i = 0 to iBound
 706             sLocal = sLocal + sArray(i)
 707         next i
 708     removeCharacter = sLocal
 709 end function
 710
 711 function fgetFileName(byVal sIn as string) as string
 712     '/// extract file name from string, where PathSeperator is always Backslash ///'
 713     '/// only used for filestring in first field from get*List() ///'
 714     dim sTemp(0) as string
 715     if ("" = sIn) then     ' workaround for i23697 split() returns wrong value on empty string
 716         sTemp(0) = ""
 717     else
 718         sTemp() = split(sIn, "\") ' GH returns hopefully always a Backslash as seperator
 719     endif
 720     fgetFileName = sTemp(uBound(sTemp()))
 721 end function
 722