'encoding UTF-8 Do not remove or change this line!
'**************************************************************
'
' Licensed to the Apache Software Foundation (ASF) under one
' or more contributor license agreements. See the NOTICE file
' distributed with this work for additional information
' regarding copyright ownership. The ASF licenses this file
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
'
' http://www.apache.org/licenses/LICENSE-2.0
'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
' KIND, either express or implied. See the License for the
' specific language governing permissions and limitations
' under the License.
'
'**************************************************************
'*
'* short description : Replacements for routines in t_lists.inc adds some
'*
'\******************************************************************************
function hListDelete( aList() as string, iItemToDelete as integer ) as boolean
'///
Delete one item from a list specified by index
'///Prerequisite: Array compatible with those from t_lists.inc
'///About listfunctions: All listfunctions rely on a special type of
'///+ array. This can be string arrays and - in some cases - numeric
'///+ arrays. What makes the arrays unique is that the first item which
'///+ has the index 0 contains the number of items in the list to be used,
'///+ anything that is stored beyond this number is ignored. This has three
'///+ consequences: 1) all listfunctions that alter an array must update
'///+ the index stored in array(0) and 2) it is possible that the index
'///+ point beyond ubound of the array which will most likely cause a
'///+ runtime error. 3) Means that arrays may only have an upper boundary
'///+ declared, all loops must start with index array(1) and must end with
'///+ index array(val( array(0))
const CFN = "hListDelete::"
const INDEX_CORRECTION = 1
dim iCurrentItem as integer ' Increment-Variable
if ( GVERBOSE ) then
printlog( CFN & "Removing: " & aList( iItemToDelete ) & " at pos " & iItemToDelete )
endif
' Move all items down by one in the list beginning with the item after
' iItemToDelete
for iCurrentItem = ( iItemToDelete + INDEX_CORRECTION ) to ListCount( aList() )
aList( iCurrentItem - INDEX_CORRECTION ) = aList( iCurrentItem )
next iCurrentItem
' Delete the last entry, it is no longer used and it is duplicate to the item
' at iListSizeOld-1 (iListSizeNew)
aList( iCurrentItem ) = ""
aList( 0 ) = iCurrentItem - INDEX_CORRECTION
end function
'*******************************************************************************
function hListAppend( sNewString as string, aTargetList() as string ) as integer
'///Append an item to an existing list
'///Prerequisite: Array compatible with those from t_lists.inc
'///About listfunctions: All listfunctions rely on a special type of
'///+ array. This can be string arrays and - in some cases - numeric
'///+ arrays. What makes the arrays unique is that the first item which
'///+ has the index 0 contains the number of items in the list to be used,
'///+ anything that is stored beyond this number is ignored. This has three
'///+ consequences: 1) all listfunctions that alter an array must update
'///+ the index stored in array(0) and 2) it is possible that the index
'///+ point beyond ubound of the array which will most likely cause a
'///+ runtime error. 3) Means that arrays may only have an upper boundary
'///+ declared, all loops must start with index array(1) and must end with
'///+ index array(val( array(0))
const CFN = "hListAppend::"
const RC_ARRAY_TOO_SMALL = -1
dim iCurrentListSize as integer
dim iNewListSize as integer
dim iArraySize as integer
dim irc as integer
iCurrentListSize = val( aTargetList( 0 ) )
iNewListSize = iCurrentListSize + 1
iArraySize = ubound( aTargetList() )
if ( iNewListSize > iArraySize ) then
warnlog ( CFN & "Cannot append, array too small" )
printlog( CFN & "Array-Size.....: " & iArraySize )
printlog( CFN & "Requested index: " & iNewListSize )
hListAppend() = RC_ARRAY_TOO_SMALL
else
aTargetList( iNewListSize ) = sNewString
aTargetList( 0 ) = iNewListSize
hListAppend() = iNewListSize
endif
end function
'*******************************************************************************
function hManageComparisionList( sFileIn as string, sFileOut as string, sListOut() as string ) as integer
'///Function to create or compare a list to a reference
'///Prerequisite: List of items to compare, input- and outputfilename
'///About listfunctions: All listfunctions rely on a special type of
'///+ array. This can be string arrays and - in some cases - numeric
'///+ arrays. What makes the arrays unique is that the first item which
'///+ has the index 0 contains the number of items in the list to be used,
'///+ anything that is stored beyond this number is ignored. This has three
'///+ consequences: 1) all listfunctions that alter an array must update
'///+ the index stored in array(0) and 2) it is possible that the index
'///+ point beyond ubound of the array which will most likely cause a
'///+ runtime error. 3) Means that arrays may only have an upper boundary
'///+ declared, all loops must start with index array(1) and must end with
'///+ index array(val( array(0))
'///BEWARE: This is a core function and used by many tests!
'///Please read the inline documentation for further reference
'///Function parameters:
'///
'///+- sFileIn = The file that contains the reference data
'///+- sFileOut = The file new lists are written to in case of an error
'///+- sListOut() = The list containing the newly retrieved data.
'///
'///Description:
'///
const CFN = "hManageComparisionList::"
' maximum lines per file. Currently this limit is determined by the help
' tests which have up to 22000 entries + reseve.
const FILESIZE = 25000
const COMPARE_SUCCESS = 0
const ENCODING_UTF8 = "UTF8"
dim irc as integer
dim aReferenceList( FILESIZE ) as string
if ( GVERBOSE ) then printlog( CFN & "Reading: " & sFileIn )
' Do not use hGetDataFileSection() as strings in some lists may begin with a
' "#" which is interpreted as a comment by hGetDataFileSection()
listread( aReferenceList(), sFileIn, ENCODING_UTF8 )
' Word of caution: If the number of new items equals the number of removed items
' this function returns 0 -> success. This case is highly unlikely to ever happen
' unless someone renames scripts.
irc = hListCompare( sListOut() , aReferenceList() )
'///+- In case the lists are not identical, write the new one to the local work directory
if ( irc = COMPARE_SUCCESS ) then
printlog( CFN & "Comparision succeeded" )
hManageComparisionList() = COMPARE_SUCCESS
else
printlog( CFN & "The two compared lists differ. There are a number of possible reasons:" )
printlog( CFN & "- Installation requirements are not met (setup /a?, missing packages?)" )
printlog( CFN & "- Reference and actual UI-Content do not match: File an issue." )
printlog( CFN & "- The reference file does not exist: Follow steps below." )
printlog( CFN & "Verify and copy the file: " & sFileOut )
printlog( CFN & "to this location........: " & sFileIn )
printlog( CFN & "Check this file into the SCM or attach it to an issue" )
listwrite( sListOut(), sFileOut, ENCODING_UTF8 )
hManageComparisionList() = irc
endif
'///+- Return number of differences between the lists
'///
end function
'*******************************************************************************
function hListCompare( aListOne() as String, aListTwo() as String ) as integer
const CFN = "hListcompare::"
'///Compare two lists with each other, where list TWO is the reference
'///Prerequisites: Two lists compatible with listfunctions
'///About listfunctions: All listfunctions rely on a special type of
'///+ array. This can be string arrays and - in some cases - numeric
'///+ arrays. What makes the arrays unique is that the first item which
'///+ has the index 0 contains the number of items in the list to be used,
'///+ anything that is stored beyond this number is ignored. This has three
'///+ consequences: 1) all listfunctions that alter an array must update
'///+ the index stored in array(0) and 2) it is possible that the index
'///+ point beyond ubound of the array which will most likely cause a
'///+ runtime error. 3) Means that arrays may only have an upper boundary
'///+ declared, all loops must start with index array(1) and must end with
'///+ index array(val( array(0))
'///Duplicates gCompare2Lists but does not print warnlogs, evaluate returncode instead
'///
dim aOneOnlyList( ubound( aListOne() ) ) as string
dim aTwoOnlyList( ubound( aListTwo() ) ) as string
dim iListOneIndex as integer
dim iListTwoIndex as integer
dim iTwoOnlyListSize as integer
dim iListOneSize as integer
dim bFound as boolean
'///+- Create a copy of list two so we do not change the original list
ListCopy( aListTwo() , aTwoOnlyList() )
iTwoOnlyListSize = ListCount( aTwoOnlyList() )
iListOneSize = ListCount( aListOne() )
'///+- Step through each item in list one
for iListOneIndex = 1 to iListOneSize
bFound = false
'///+- Compare it to each item in list two
for iListTwoIndex = 1 to iTwoOnlyListSize
'///+- If the entries match, delete it from the TwoOnly list
if ( aListOne( iListOneIndex ) = aTwoOnlyList( iListTwoIndex ) ) then
bFound = true
aTwoOnlyList( iListTwoIndex ) = aTwoOnlyList( iTwoOnlyListSize )
' this breaks compatibility to listfunctions because the actual
' number of items is out of sync with listcount
iTwoOnlyListSize = iTwoOnlyListSize -1
exit for
end if
next iListTwoIndex
'///+- If there is no match, the item exists in list one only -> copy
if ( not bFound ) then hListAppend( aListOne( iListOneIndex ), aOneOnlyList() )
next iListOneIndex
' restore compatibility to listfunctions so hListPrint() will not fail
aTwoOnlyList( 0 ) = iTwoOnlyListSize
'///+- List all items that exist in List One only
if ( ListCount( aOneOnlyList() ) > 0 ) then
printlog( CFN & "Objects have been added to the list" )
hListPrint( aOneOnlyList() , "Items found in list ONE only (NEW)" )
hListCompare() = ListCount( aOneOnlyList() )
end if
'///+- List all items that exist in List Two only
if ( ListCount( aTwoOnlyList() ) > 0 ) then
printlog( CFN & "Objects have been removed from the list" )
hListPrint( aTwoOnlyList() , "Items found in list TWO only (MISSING)" )
hListCompare() = ListCount( aTwoOnlyList() ) * -1
end if
'///
end function
'*******************************************************************************
function hListPrependString( aList() as string, cString as string ) as boolean
'///Insert a string infront of each item in a list
'///Prerequisites: A list compatible with listfunctions
'///About listfunctions: All listfunctions rely on a special type of
'///+ array. This can be string arrays and - in some cases - numeric
'///+ arrays. What makes the arrays unique is that the first item which
'///+ has the index 0 contains the number of items in the list to be used,
'///+ anything that is stored beyond this number is ignored. This has three
'///+ consequences: 1) all listfunctions that alter an array must update
'///+ the index stored in array(0) and 2) it is possible that the index
'///+ point beyond ubound of the array which will most likely cause a
'///+ runtime error. 3) Means that arrays may only have an upper boundary
'///+ declared, all loops must start with index array(1) and must end with
'///+ index array(val( array(0))
'///Note that the function alters the input list. If the list contains
'///+ strings of the type "MyString" the items will be changed to
'///+ read "Some Text : MyString"
'///Input:
'///
'///+- List (string)
'///+- A text to be inserted infront of every item in the list
'///
'///Returns:
'///
'///+- Errorcondition (boolean)
'///
'///+- The returnvalue is currently undefined
'///
'///
'///Description:
'///
const CFN = "hListPrependString::"
dim iCurrentItem as integer
'///+- Cycle through the list and insert a text infront of each item
for iCurrentItem = 1 to listcount( aList() )
aList( iCurrentItem ) = cString & " : " & aList( iCurrentItem )
next iCurrentItem
hListPrependString() = true
'///
end function
'*******************************************************************************
function hListAppendList( aBaseList() as string, aListToAppend() as string ) as integer
'///Append one list to another
'///Prerequisites: A list compatible with listfunctions
'///About listfunctions: All listfunctions rely on a special type of
'///+ array. This can be string arrays and - in some cases - numeric
'///+ arrays. What makes the arrays unique is that the first item which
'///+ has the index 0 contains the number of items in the list to be used,
'///+ anything that is stored beyond this number is ignored. This has three
'///+ consequences: 1) all listfunctions that alter an array must update
'///+ the index stored in array(0) and 2) it is possible that the index
'///+ point beyond ubound of the array which will most likely cause a
'///+ runtime error. 3) Means that arrays may only have an upper boundary
'///+ declared, all loops must start with index array(1) and must end with
'///+ index array(val( array(0))
'///Input:
'///
'///+- Target list (string)
'///+- Source list (string)
'///
'///Returns:
'///
'///+- Listsize (integer)
'///
'///+- The size of the sum of both lists
'///+- 0 in case of error
'///
'///
'///Description:
'///
const CFN = "hListAppendList::"
dim iCurrentItem as integer
dim iNewSize as integer
'///+- Do some basic boundary checking
if ( ubound( aBaseList() ) < _
( listcount( aBaseList ) + listcount( aListToAppend() ) ) ) then
warnlog( CFN & "Base Array too small" )
iNewSize = 0
else
'///+- Append the list
for iCurrentItem = 1 to listcount( aListToAppend() )
hListAppend( aBaseList() , aListToAppend( iCurrentItem ) )
next iCurrentItem
iNewSize = listcount( aBaseList() )
endif
'///
end function
'*******************************************************************************
function hCountMatchesInList( acItemList() as string, cSearchTerm as string ) as integer
'///Find out how many times a string is found in a list
'///Parameter(s):
'///
'///+- List to be searched (String)
'///
'///+- The list may not be empty
'///+- Search begins at index 1
'///
'///+- Expression to search for (String)
'///
'///+- Only exact matches are counted
'///
'///
'///Returns:
'///
'///+- Number of hits (Integer)
'///
'///+- 0: if no matches were found
'///+- -1: Any error
'///
'///
const CFN = "hCountMatchesInList::"
dim iHitCount as integer
dim iCurrentItem as integer
if ( GVERBOSE ) then printlog( CFN & "Begin with term: " & cSearchTerm )
for iCurrentItem = 1 to ListCount( acItemList() )
if ( GVERBOSE ) then printlog( acItemList( iCurrentItem ) )
if ( instr( acItemList( iCurrentItem ), cSearchTerm ) > 0 ) then
iHitCount = iHitCount + 1
endif
next iCurrentItem
if ( GVERBOSE ) then printlog( CFN & "Exit with result: " & iHitCount )
hCountMatchesInList() = iHitCount
end function
'*******************************************************************************
function hListResultEvaluation( i_diffcount as integer, i_allowed_delta as integer ) as boolean
' This function evaluates the outcome of hManageComaprisionList() or
' hListCompare(). This extra step is done because in some cases the
' program installations might differ slightly - in some CWS (when using the
' archive) we can end up having a different set of import/export filters.
' So the evaluation must allow for a specific number of mismatches which is
' specified in i_allowed_delta.
hListResultEvaluation() = true
' If lists are identical we return directly.
if ( i_diffcount = 0 ) then
printlog( "The lists are identical. Good" )
exit function
endif
' if we have differences we need to have a closer look.
' Note that the difference is optional.
if ( i_allowed_delta <> 0 ) then
if ( i_diffcount = i_allowed_delta ) then
printlog( "The lists have the allowed delta of " & i_allowed_delta )
exit function
endif
endif
warnlog( "The list check failed, please review the test." )
hListResultEvaluation() = false
end function