testautomation/global/tools/includes/required/t_lists.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: t_lists.inc,v $
  10 '*
  11 '* $Revision: 1.1 $
  12 '*
  13 '* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $
  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 : helge.delfs@sun.com
  35 '*
  36 '* short description : general routines to work with lists (arrays)
  37 '*
  38 '\******************************************************************
  39
  40 function ListCount ( lsList() as String ) as Integer
  41     'Author: tz
  42     '///Returns the number of list entries.
  43     '///+<u>Input</u>: The list (only string lists are possible)
  44     '///+<u>Return</u>: The number of entries
  45     ListCount =  Val(lsList(0))
  46 end function
  47
  48 '-------------------------------------------------------------------------
  49
  50 function ListCopy ( lsList1() as String, lsList2() as String ) as Boolean
  51     'Author: tz
  52     '///Copies all entries out of one list into another list.
  53     '///+<u>Input</u>:<ol><lo>list which should be copied</li><li>An empty list</li></ol>After this function the 2nd list is a copy of the 1st list.
  54     '///+<u>Return</u>: If copy of the list is correct this function returns TRUE otherweise FALSE
  55
  56     Dim ii as Integer
  57
  58     ListAllDelete ( lsList2() )
  59     for ii=1 to ListCount ( lsList1() )
  60         ListAppend ( lsList2(), lsList1(ii) )
  61     next ii
  62
  63     if ListCount ( lsList1() ) = ListCount ( lsList2 () ) then
  64         ListCopy = TRUE
  65     else
  66         ListCopy = FALSE
  67     end if
  68 end function
  69
  70 '-------------------------------------------------------------------------
  71
  72 sub ListAllDelete ( lsList() as String )
  73     'Author: tz
  74     '///Deletes a complete list.
  75     '///+<u>Input</u>: The list (only string lists are possible)
  76     lsList(0) = "0"
  77 end sub
  78
  79 '-------------------------------------------------------------------------
  80
  81 sub ListAppend ( lsList() as String, sNewEntry as String )
  82     'Author: tz
  83     '///Appends a new entry at the end of the list.
  84     '///+<u>Input</u>: <ol><li>the list (only string lists are possible)</li><li>The new entry</li></ol>
  85     lsList(0) = Val(lsList(0)) + 1
  86     lsList( lsList(0) ) = sNewEntry
  87 end sub
  88
  89 '-------------------------------------------------------------------------
  90
  91 function ListDelete ( lsList() as String, iNr as Integer ) as Boolean
  92     'Author: tz
  93     '///Deletes an entry out of the list on a defined position (iNr).
  94     '///+<u>Input</u>: <ol><li>The list (only string lists are possible)</li><li>The position of the entry</li></ol>
  95     '///+<u>Return</u>: TRUE if the entry was deleted otherweise FALSE
  96
  97
  98     Dim i%, ListenAnzahl as Integer
  99
 100     ListenAnzahl = listcount( lsList() )
 101
 102     if iNr > ListenAnzahl then
 103         ListDelete = FALSE
 104         Exit Function
 105     end if
 106
 107     for i% = iNr to ListenAnzahl
 108         lsList( i% ) = lsList( i% + 1 )
 109     next i%
 110
 111     lsList(0) = ListenAnzahl - 1
 112
 113     ListDelete = TRUE
 114 end function
 115
 116 '-------------------------------------------------------------------------
 117
 118 function ListDeleteString ( lsList() as String, sText as String ) as Boolean
 119     'Author: tz
 120     '///Deletes the 1st string in the list which is equal to the input string.
 121     '///+<u>Input</u>: <ol><li>The list (only string lists are possible)</li><li>The string</li></ol>
 122     '///+<u>Return</u>: TRUE if the entry was deleted otherwise FALSE
 123     Dim i as Integer : Dim EintragsNr as Integer : Dim ListenAnzahl as Integer
 124
 125     ListenAnzahl = Val(lsList(0))
 126     EintragsNr = 0
 127     for i = 1 to ListenAnzahl
 128         if lsList(i) = sText then
 129             EintragsNr = i
 130             i = ListenAnzahl + 1
 131         end if
 132     next i
 133     if EintragsNr = 0 then
 134         ListDeleteString = FALSE
 135     else
 136         ListDeleteString = ListDelete ( lsList(), EintragsNr )
 137     end if
 138 end function
 139
 140 '-------------------------------------------------------------------------
 141
 142 function ListInsert ( lsList() as String, ZeileNr%, sWert$ ) as Boolean
 143     'Author: tz
 144     '///Inserts a string at a defined position in the list.
 145     '///+<u>Input</u>: <ol><li>The list (only string lists are possible)</li><li>The position</li><li>The string</li></ol>
 146     '///+<u>Return</u>: TRUE if the entry was inserted otherwise FALSE
 147     Dim i% : Dim ListenAnzahl as Integer
 148
 149     ListenAnzahl = Val(lsList(0))
 150     if ZeileNr% > ListenAnzahl then
 151         ListInsert = FALSE
 152         Exit Function
 153     end if
 154
 155     ' Nach hinten verschieben, hinten beginnend
 156     for i% = ListenAnzahl to ZeileNr% step -1
 157         lsList( i%+1 ) = lsList( i% )
 158     next i%
 159
 160     ' Einfuegen
 161     lsList( ZeileNr% ) = sWert$
 162     lsFile(0) = ListenAnzahl + 1
 163     ListInsert = TRUE
 164
 165 end function
 166
 167 '-------------------------------------------------------------------------
 168
 169 function ListRead ( lsList() as String, Datei$, optional sEncode as String ) as Boolean
 170     'Author: tz
 171     '///+Opens a file and insert all rows into a list (row for row).
 172     '///+<u>Input</u>: <ol><li>The list (old list entries will be deleted)</li><li>The file</li><li><b>optional</b>: The encoding &quot;UTF8&quot;</li></ol>
 173     '///+<u>Return</u>: TRUE or FALSE if this routine can read the file.
 174     Dim bUTF8 as Boolean
 175     Dim i%
 176     Dim CompareList(15000) as String
 177
 178     if Dir( Datei$ ) = "" then
 179         Warnlog "ListRead: " + Datei$ + " is missing!"
 180         ListRead = FALSE
 181         exit function
 182     end if
 183
 184     if IsMissing ( sEncode ) = TRUE then
 185         bUTF8 = FALSE
 186     else
 187         if UCASE ( sEncode ) = "UFT8" OR UCASE ( sEncode ) = "UTF8" then
 188             bUTF8 = TRUE
 189         else
 190             Warnlog "ListRead :" +  sEncode + " - Encoding is unkown!"
 191             bUTF8 = FALSE
 192         end if
 193     end if
 194
 195     ListAllDelete ( lsList() )                             ' clean up the list
 196
 197     if bUTF8 =  TRUE then
 198         Dim textin as object, sfa as object, xInput as object                   ' for UTF-8-input-routines
 199         Dim iC as Integer
 200
 201         textin = createUnoService( "com.sun.star.io.TextInputStream" )         ' uno-handling to input an UFT-8-File
 202         textin.setEncoding("utf8")                                             '
 203         sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )          '
 204         xInput = sfa.openFileRead( Datei$ )                                    '
 205         textin.setInputStream( xInput )                                        '
 206
 207         do until textin.isEOF()                                                '
 208             i% = Val(lsList(0)) + 1
 209             lsList(0) = i%
 210             lsList( i% ) = textin.readLine()                                    '
 211         loop
 212         xInput.closeInput                                                      ' uno-file-close
 213
 214         'INFO: (TZ) Only to workaround a problem with UNIX-Files...
 215         if Right ( lsList(i%), 1 ) = Chr(10) then
 216             lsList(i%) = Left ( lsList(i%), Len ( lsList(i%) ) - 1 )
 217         end if
 218         'INFO: (TBO) Remove the BOM http://www.unicode.org/versions/Unicode4.0.0/ch15.pdf
 219         if (left(lsList(1), 1) = chr(&HFEFF)) then
 220             lsList(1) = right(lsList(1), Len(lsList(1)) - 1)
 221         end if
 222     else
 223         Dim FileNum%
 224
 225         FileNum% = FreeFile
 226         Open Datei$ for input  as #FileNum%
 227
 228         do until EOF(#FileNum%) ' all from LIS-file
 229             i% = Val(lsList(0)) + 1
 230             lsList(0) = i%
 231             Line Input #FileNum%, lsList( i% )
 232         loop
 233         Close #FileNum%
 234     end if
 235     ListRead = TRUE
 236 end function
 237
 238 '-------------------------------------------------------------------------
 239
 240 function ListWrite ( lsList() as String, Datei$, optional sEncode as String) as Boolean
 241     'Author: tz
 242     '///+Writes a list into a file (an existing file will be deleted before)
 243     '///+<u>Input</u>: <ol><li>The list</li><li>The file</li><li><b>optional</b>: The encoding &quot;UTF8&quot;</li></ol>
 244     '///+<u>return</u>: TRUE or FALSE if this routine can read the file.
 245
 246     Dim bUTF8 as Boolean
 247     Dim i%
 248
 249     if Dir (Datei$) <> "" then
 250         Kill(Datei$)  ' the file must be deleted if you use 'UTF8'
 251     endif
 252
 253     if IsMissing ( sEncode ) = TRUE then
 254         bUTF8 = FALSE
 255     else
 256         if UCASE ( sEncode ) = "UTF8" then
 257             bUTF8 = TRUE
 258         else
 259             Warnlog "ListWrite :" +  sEncode + " - Encoding is unkown!"
 260             bUTF8 = FALSE
 261         end if
 262     end if
 263
 264     if bUTF8 =  TRUE then
 265         Dim textout as object, sfa as object, xOutput as object                  ' for UTF-8-output-routines
 266
 267         textout = createUnoService( "com.sun.star.io.TextOutputStream" )        ' uno-handling to output an UFT-8-File
 268         textout.setEncoding("utf8")                                             '
 269         sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )           '
 270         xOutput = sfa.openFileWrite( Datei$ )                                   '
 271         textout.setOutputStream( xOutput )                                      '
 272
 273         for i%=1 to ListCount ( lsList() )
 274             textout.writeString( lsList( i% ) + Chr(13) + Chr(10) )              '
 275         next i%
 276         xOutput.closeOutput                                                     ' uno-file-close
 277     else
 278         Dim FileNum% : Dim iLast%
 279
 280         FileNum% = FreeFile
 281         Open Datei$ for Output  as #FileNum%
 282         iLast% = Val(lsList(0))
 283         i%=1
 284         do while i% <= iLast%
 285             Print #FileNum%, lsList(i%)
 286             i% = i% +1
 287         loop
 288         Close #FileNum%
 289     endif
 290
 291     ListWrite = TRUE
 292 end function
 293
 294 '-------------------------------------------------------------------------
 295
 296 function ListReadAppend( lsList() as String , Datei$, optional sEncode as String ) as Boolean
 297     'Author: tz
 298     '///+Appends a list into a file (If the file exists the file will be deleted before!).
 299     '///+<u>Input</u>: <ol><li>The list</li><li>The file</li><li><b>optional</b>: The encoding &quot;UTF8&quot;</li></ol>
 300     '///+<u>return</u>: TRUE or FALSE if this routine can read the file.
 301
 302     Dim bUTF8 as Boolean
 303     Dim i%
 304     Dim CompareList() as String
 305     Dim isCounter as Integer
 306     Dim FileNum%
 307
 308     if Dir( Datei$ ) = "" then
 309         Warnlog "ListReadAppend : " + Datei$ + " is missing!"
 310         ListReadAppend = FALSE
 311         exit function
 312     end if
 313
 314     isCounter = ListCount ( lsList() )
 315
 316     if IsMissing ( sEncode ) = TRUE then
 317         bUTF8 = FALSE
 318     else
 319         if UCASE ( sEncode ) = "UFT8" OR UCASE ( sEncode ) = "UTF8" then
 320             bUTF8 = TRUE
 321         else
 322             Warnlog "ListRead : " + sEncode + " - Encoding is unkown!"
 323             bUTF8 = FALSE
 324         end if
 325     end if
 326
 327     if bUTF8 =  TRUE then
 328         Dim textin as object, sfa as object, xInput as object                  ' for UTF-8-input-routines
 329
 330         textin = createUnoService( "com.sun.star.io.TextInputStream" )         ' uno-handling to input an UFT-8-File
 331         textin.setEncoding("utf8")                                             '
 332         sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )          '
 333         xInput = sfa.openFileRead( Datei$ )                                    '
 334         textin.setInputStream( xInput )                                        '
 335
 336         do until textin.isEOF()                                                '
 337             i% = Val(lsList(0)) + 1
 338             lsList(0) = i%
 339             lsList( i% ) = textin.readLine()                                    '
 340         loop
 341         xInput.closeInput                                                      ' uno-file-close
 342
 343         'INFO: (TZ) Only to workaround a problem with UNIX-Files...
 344         if Right ( lsList(i%), 1 ) = Chr(10) then
 345             lsList(i%) = Left ( lsList(i%), Len ( lsList(i%) ) - 1 )
 346         end if
 347         '...
 348     else
 349         FileNum% = FreeFile
 350         Open Datei$ for input  as #FileNum%
 351
 352         do until EOF(FileNum%)                            ' All from LIST-file
 353             i% =  Val(lsList(0)) + 1
 354             lsList(0) = i%
 355             Line Input #FileNum%, lsList( i% )
 356         loop
 357         Close #FileNum%
 358     end if
 359
 360     ListReadAppend = TRUE
 361
 362 end function
 363
 364 '-------------------------------------------------------------------------
 365
 366 function ListWriteAppend( lsList() as String, Datei$, optional sEncode as String ) as Boolean
 367     'Author: tz
 368     '///+Writes a list into a file (If the files exist all entries will be appended).
 369     '///+<u>Input</u>: <ol><li>The list</li><li>The file</li><li><b>optional</b>: The encoding &quot;UTF8&quot;</li></ol>
 370     '///+<u>return</u>: TRUE or FALSE if this routine can read the file.
 371
 372     Dim bUTF8 as Boolean
 373     Dim i%
 374     Dim DummyList ( 15000 ) as String
 375
 376     if IsMissing ( sEncode ) = TRUE then
 377         bUTF8 = FALSE
 378     else
 379         if UCASE ( sEncode ) = "UTF8" then
 380             bUTF8 = TRUE
 381         else
 382             Warnlog "ListRead :" +  sEncode + " - Encoding is unkown!"
 383             bUTF8 = FALSE
 384         end if
 385     end if
 386
 387     if bUTF8 =  TRUE then
 388         Dim sfa as object, xOutput as object, textout as object                 ' for UTF-8-output-routines
 389
 390         ListRead ( DummyList(), Datei$, "utf8" )                               ' read old file in another list
 391         for i% = 1 to ListCount ( lsList() )
 392             ListAppend ( DummyList(), lsList(i%) )                              ' add the new list at the old list
 393         next i%
 394
 395         textout = createUnoService( "com.sun.star.io.TextOutputStream" )       ' uno-handling to output an UFT-8-File
 396         textout.setEncoding("utf8")                                            '
 397         sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )          '
 398         xOutput = sfa.openFileWrite( Datei$ )                                  '
 399         textout.setOutputStream( xOutput )                                     '
 400
 401         for i%=1 to ListCount (DummyList())
 402             textout.writeString( DummyList( i% ) + Chr(13) + Chr(10 )           '
 403         next i%
 404         xOutput.closeOutput                                                    ' uno-file-close
 405     else
 406         Dim FileNum%
 407
 408         FileNum% = FreeFile
 409         Open Datei$ for Append  as #FileNum%
 410
 411         for i% = 1 to Val(lsList(0))
 412             Print #FileNum%, lsList(i%)
 413         next i%
 414
 415         Close #FileNum%
 416     end if
 417     ListWriteAppend = TRUE
 418
 419 end function
 420
 421 '-------------------------------------------------------------------------
 422
 423 sub ListSort ( lsList() as String, optional UpDown as Boolean )
 424     'Author: tz
 425     '///+Sorts a list upward per default or downward if optional parameter is FALSE with quicksort method.
 426     '///+<u>Input</u>: Unsorted list
 427
 428     Dim Listenanzahl as Integer, i as Integer, j as Integer
 429     Dim Zwischenspeicher as String
 430
 431     ListenAnzahl = Val(lsList(0))
 432     for i=ListenAnzahl-1 to 1 step -1
 433         for j=1 to i
 434             if UpDown = FALSE then
 435                 ' upward sorting
 436                 if uCase ( lsList(j) ) < uCase ( lsList(j+1) ) then
 437                     Zwischenspeicher = lsList (j)                               ' invert value (i) with value (i+1)
 438                     lsList (j) = lsList(j+1)
 439                     lsList (j+1) = Zwischenspeicher
 440                 end if
 441             else
 442                 ' Downward sorting
 443                 if uCase ( lsList(j) ) > uCase ( lsList(j+1) ) then
 444                     Zwischenspeicher = lsList (j)                               ' invert value (i) with value (i+1)
 445                     lsList (j) = lsList(j+1)
 446                     lsList (j+1) = Zwischenspeicher
 447                 end if
 448             end if
 449         next j
 450     next i
 451 end sub
 452
 453 '*******************************************************************************
 454
 455 function gCompare2Lists( aListOne() as String, aListTwo() as String ) as boolean
 456
 457     const CFN = "global::tools::inc::t_list.inc::gCompare2Lists: "
 458
 459     '///<h3>Compare two lists with each other, where <b>list TWO</b> is the reference</h3>
 460     '///<ul>
 461
 462     dim aOneOnlyList( ubound( aListOne() ) ) as string
 463     dim aTwoOnlyList( ubound( aListTwo() ) ) as string
 464
 465     dim iListOneIndex as integer
 466     dim iListTwoIndex as integer
 467
 468     dim bFound as boolean
 469     dim brc as boolean     ' returncode: true if lists are identical
 470     brc = true
 471
 472     '///+<li>Create a copy of list two so we do not change the original list</li>
 473     ListCopy( aListTwo() , aTwoOnlyList() )
 474
 475     '///+<li>Step through each item in list one</li>
 476     for iListOneIndex = 1 to ListCount( aListOne() )
 477
 478         bFound = false
 479
 480         '///+<li>Compare it to each item in list two</li>
 481         for iListTwoIndex = 1 to ListCount( aTwoOnlyList() )
 482
 483             '///+<li>If the entries match, delete it from the TwoOnly list</li>
 484             if ( aListOne( iListOneIndex ) = aTwoOnlyList( iListTwoIndex ) ) then
 485
 486                 bFound = true
 487                 ListDelete( aTwoOnlyList() , iListTwoIndex )
 488                 exit for
 489
 490             end if
 491
 492         next iListTwoIndex
 493
 494         '///+<li>If there is no match, the item exists in list one only -> copy</li>
 495         if ( not bFound ) then
 496             ListAppend( aOneOnlyList() , aListOne( iListOneIndex ) )
 497         end if
 498
 499     next iListOneIndex
 500
 501     '///+<li>List all items that exist in List One only</li>
 502     if ( ListCount( aOneOnlyList() ) > 0 ) then
 503         warnlog( CFN & "Objects have been added to the list" )
 504         hListPrint( aOneOnlyList() , "Items found in list ONE only (NEW)" )
 505         brc = false
 506     end if
 507
 508     '///+<li>List all items that exist in List Two only</li>
 509     if ( ListCount( aTwoOnlyList() ) > 0 ) then
 510         warnlog( CFN & "Objects have been removed from the list" )
 511         hListPrint( aTwoOnlyList() , "Items found in list TWO only (MISSING)" )
 512         brc = false
 513     end if
 514
 515     gCompare2Lists() = brc
 516     '///</ul>
 517
 518 end function
 519
 520 '*******************************************************************************
 521
 522 function hListPrint( lsList() as string , optional cComment as string ) as integer
 523
 524     const CFN = "global::tools::inc::t_list.inc::hListPrint: "
 525
 526     '///<h3>Print the content of a list to the log with a heading comment</h3>
 527     '///<ul>
 528
 529     dim iListItem as integer
 530
 531     '///+<li>If no comment is provided we print a qaerrorlog</li>
 532     if ( ismissing( cComment ) ) then
 533         qaerrorlog( CFN & "Please provide any string as second parameter." )
 534         cComment = ""
 535     end if
 536
 537     '///+<li>Print a comment if desired</li>
 538     if ( cComment <> "" ) then
 539         printlog( "" )
 540         printlog( CFN & cComment )
 541         printlog( "" )
 542     end if
 543
 544     '///+<li>Print all items in the list to the log</li>
 545     for iListItem = 1 to listcount( lsList() )
 546         printlog( "(" & iListItem & ") :  " & lsList( iListItem ) )
 547     next iListItem
 548
 549     '///+<li>Return the number of listitems to the calling function</li>
 550     hListPrint() = listcount( lsList() )
 551
 552     '///</ul>
 553
 554 end function
 555
 556 '*******************************************************************************
 557
 558 function hListClearPattern( lsList() as string, cPattern as string ) as integer
 559
 560     '///<h3>Search a list for the occurrence of a special pattern.</h3>
 561     '///+ If the pattern is found, the entries are deleted, the new size of the
 562     '///+ array is returned.
 563
 564     dim iCurItem as integer
 565     iCurItem = 1
 566
 567     do while ( iCurItem <= listcount( lsList() ) )
 568
 569         if ( instr( lsList( iCurItem ) , cPattern ) <> 0 ) then
 570             listdelete( lsList() , iCurItem )
 571         else
 572             iCurItem = iCurItem + 1
 573         end if
 574
 575     loop
 576
 577     hListClearPattern() = listcount( lsList() )
 578
 579 end function
 580
 581 '*******************************************************************************
 582
 583 function hListClearBlank( lsList() as string ) as integer
 584
 585     '///<h3>Search a list for blank lines and remove them.</h3>
 586
 587     dim iCurItem as integer
 588     iCurItem = 1
 589
 590     do while ( iCurItem <= listcount( lsList() ) )
 591
 592         if ( len( lsList( iCurItem ) )  = 0 ) then
 593             listdelete( lsList() , iCurItem )
 594         else
 595             iCurItem = iCurItem + 1
 596         end if
 597
 598     loop
 599
 600     hListClearBlank() = listcount( lsList() )
 601
 602 end function
 603
 604 '*******************************************************************************
 605
 606 function hListIntegrityTest( sList() as string ) as boolean
 607
 608     const CFN = "global::tools::inc::t_list.inc::hListIntegrityTest:"
 609
 610     '///<h3>Verify that listcount( array ) < ubound( array )</h3>
 611     ' NOTE: some listfunctions fail if ubound = listcount
 612
 613     dim iListCount as integer
 614     dim iUbound as integer
 615
 616     iListCount = listcount( sList() )
 617     iUbound = ubound( sList() )
 618
 619     if ( iListCount >= iUbound ) then
 620         warnlog( CFN & "ListCount points beyond array boundary" )
 621         warnlog( CFN & "ListCount: " & iListCount )
 622         warnlog( CFN & "UBOUND...: " & iUbound )
 623         hListIntegrityTest() = false
 624         exit function
 625     end if
 626
 627     hListIntegrityTest() = true
 628
 629 end function
 630
 631