# utilities1.tcl
# Copyright for URLibService (c) 1995 - 2026
# by Gerald Banon. All rights reserved.

# checking the use of MultipleSubmit in cgi scripts only - done in this file by GJFB on 2012-12-16

package provide dpi.inpe.br/banon/1998/08.02.08.56 2.1

# ----------------------------------------------------------------------
# DirectoryContent
# recurrent procedure
# OBS: the two directories doc and '\doc', together (in Linux), in the doc directory result in "too many nested evaluations (infinite loop?)" 
# build a list of all the files contained in a directory and its childs
# dir is the absolute path to doc, source, agreement or doc/tmp (see iconet.com.br/banon/2007/01.01.16.00 for doc/tmp)
# bound == {} means no limit to the number of files
# otherwise $bound is the maximum number of files returned
# Example:
# DirectoryContent docContent $docPath $docPath
# used in CreateDirectoryContentList

if {[info tclversion] <= 8.3} {
	proc DirectoryContent {listName homePath dir {bound {}}} {
		upvar $listName list
#		set fileList [glob -nocomplain $dir/.* $dir/*]
#		set fileList [lrange $fileList 2 end]	;# drop . ..
		set fileList [glob -nocomplain -- $dir/* $dir/.?*]
		set index [lsearch -exact $fileList $dir/..]
		set fileList [lreplace $fileList $index $index]
		foreach file $fileList {
			if [file isdirectory $file] {
				DirectoryContent list $homePath $file $bound
			} else {
				if {![string equal {} $bound] && [llength $list] > $bound} { 
#					return -code return
					return
				}				
				regsub $homePath/ $file {} file
				lappend list $file
			}
		}
	}
} else {
	proc DirectoryContent {listName homePath dir {bound {}}} {
		global tcl_platform		
		upvar $listName list
# puts $dir		
		
		regsub -all {\{} $dir {\{} dir	;# added by GJFB on 2022-08-28 - { is a glob construct
		regsub -all {\}} $dir {\}} dir	;# added by GJFB on 2022-08-28 - } is a glob construct
		regsub -all {\]} $dir {\]} dir	;# added by GJFB on 2022-08-28 - ] is a glob construct
		regsub -all {\[} $dir {\[} dir	;# added by GJFB on 2022-08-28 - [ is a glob construct
		set fileList [glob -nocomplain -- $dir/*]	;# in Windows, file name beginning with . are captured by glob, but not in Linux
		if {$tcl_platform(platform) == "unix"} {
# added by GJFB on 2011-10-10 to capture in Linux, file name like .htaccess
			set fileList2 [glob -nocomplain -- $dir/.?*]
			set index [lsearch -exact $fileList2 $dir/..]
			set fileList2 [lreplace $fileList2 $index $index]
			set fileList [concat $fileList $fileList2]
		}
		foreach file $fileList {
			if [file isdirectory $file] {
				DirectoryContent list $homePath $file $bound
			} else {
				if {![string equal {} $bound] && [llength $list] > $bound} { 
#					return -code return
					return
				}
				regsub $homePath/ $file {} file
				lappend list $file
			}
		}
	}
}

# set fileList {}
# set path "C:/Users/Gerald Banon/URLib 2/col/dpi.inpe.br/banon/1998/08.02.08.56/doc"		
# DirectoryContent fileList $path $path 200
# DirectoryContent fileList $path $path
# puts $fileList

# DirectoryContent - end
# ----------------------------------------------------------------------
# ComputeNOD
# Compute the Number Of Days (NOD) since January 1, 1970 up to $date
# date format is of type: yyyy.mm.dd[.hh.mm.ss]
# used to compute the statistics of a repository
# used by StartService, ComputeStatistics, GetHistogram and Statistics

proc ComputeNOD {date} {
	set monthAbbreviation(01) Jan
	set monthAbbreviation(02) Feb
	set monthAbbreviation(03) Mar
	set monthAbbreviation(04) Apr
	set monthAbbreviation(05) May
	set monthAbbreviation(06) Jun
	set monthAbbreviation(07) Jul
	set monthAbbreviation(08) Aug
	set monthAbbreviation(09) Sep
	set monthAbbreviation(10) Oct
	set monthAbbreviation(11) Nov
	set monthAbbreviation(12) Dec
	foreach {Y m d} [split $date .] {break}
	set hour [clock format 0 -format %H:%M]
#	return [expr [clock scan "$monthAbbreviation($m) $d $hour $Y"] / 3600 / 24]
	return [expr [clock scan "$hour $monthAbbreviation($m) $d, $Y"] / (3600 * 24)]

}

# ComputeNOD - end
# ----------------------------------------------------------------------
# DirectoryMTime
# Returns the content modification time of a directory
# time is in second
# flag == 0 means no limit to the number of files
# if the limit (in one directory) is reached then it returns empty
# alternateTargetFile is the alternate target file for dynamic page
# for example: if the target file name is start.html then the
# alternateTargetFile is @start.html

# info tclversion is because of glob

if {[info tclversion] <= 8.3} {
	proc DirectoryMTime {dir {flag 0} {time 0} {alternateTargetFile {}}} {
# runs with start and post
#		global tcl_platform
		
		set pwd [pwd]
		if ![file isdirectory $dir] {return {}}
		if [catch {cd $dir} err] {
			puts stderr $err
			return
		}
#		set fileList [glob -nocomplain .* *]
#		set fileList [lrange $fileList 2 end]	;# drop . ..
		set fileList [glob -nocomplain -- * .?*]
		set index [lsearch -exact $fileList {..}]
		set fileList [lreplace $fileList $index $index]
		set index [lsearch -exact $fileList {.htaccess}]
		set fileList [lreplace $fileList $index $index]	;# drop .htaccess
		set index [lsearch -exact $fileList {.htaccess2}]
		set fileList [lreplace $fileList $index $index]	;# drop .htaccess2
		set index [lsearch -exact $fileList $alternateTargetFile]
		set fileList [lreplace $fileList $index $index]	;# drop alternate target file
		set index [lsearch -exact $fileList {tmp}]
		set fileList [lreplace $fileList $index $index]	;# drop tmp - useful for ConvertPRN2PDF (in iconet.com.br/banon/2006/01.28.22.05)
		if {$flag && [llength $fileList] > 2000} {
			cd $pwd
			return {}
		}
		foreach file $fileList {
# problem with a file named:
# ~$unzip.doc
# we get the message:
# user "$unzip.doc" doesn't exist
# when running [file isdirectory $file]
# with $file == ~$unzip.doc
#
# this problem occurs with 8.0 and not with 8.3
## for that reason we put a catch
			if [file isdirectory $file] {
				set time [DirectoryMTime [file join $dir $file] $flag $time $alternateTargetFile]
			} else {
				if ![file exists ./$file] {continue}	;# accent problem after migration (for example from Windows) - glob might recognize some accent that the operational system might not (e.g., glob may recognize Portugu??sLanguage.tcl as PortuguêsLanguage.tcl - this last name is not recognized by the operational system)
				if [string equal {} $time] {
					set time [file mtime ./$file]	;# ./ is needed in a case like ~$unzip.doc
				} else {
					set time [Max $time [file mtime ./$file]]	;# ./ is needed in a case like ~$unzip.doc
				}
			}
		}
		cd $pwd
		return $time
	}
} else {
	proc DirectoryMTime {dir {flag 0} {time 0} {alternateTargetFile {}}} {
# runs with start and post
#		global tcl_platform
		global URLibServiceRepository
		
		set pwd [pwd]
		if ![file isdirectory $dir] {return {}}
		if [catch {cd $dir} err] {
			puts stderr $err
			return
		}
		set fileList [glob -nocomplain *]
		set index [lsearch -exact $fileList {.htaccess}]
		set fileList [lreplace $fileList $index $index]	;# drop .htaccess
		set index [lsearch -exact $fileList {.htaccess2}]
		set fileList [lreplace $fileList $index $index]	;# drop .htaccess2
		set index [lsearch -exact $fileList {thisInformationItemHomePage.html}]	;# added by GJFB on 2023-02-26
		set fileList [lreplace $fileList $index $index]	;# drop thisInformationItemHomePage.html	;# added by GJFB on 2023-02-26
		set index [lsearch -exact $fileList {thisArchivalUnit.html}]	;# added by GJFB on 2023-03-20
		set fileList [lreplace $fileList $index $index]	;# drop thisArchivalUnit.html.html	;# added by GJFB on 2023-03-20
		set index [lsearch -exact $fileList {thisResume.html}]	;# added by GJFB on 2024-03-19
		set fileList [lreplace $fileList $index $index]	;# drop thisResume.html.html	;# added by GJFB on 2024-03-19
		set index [lsearch -exact $fileList $alternateTargetFile]
		set fileList [lreplace $fileList $index $index]	;# drop alternate target file
		set index [lsearch -exact $fileList @errorLog]
		set fileList [lreplace $fileList $index $index]	;# drop @errorLog - useful for Administrator page for setting field value attributes (iconet.com.br/banon/2007/01.01.16.00)
		set index [lsearch -exact $fileList {tmp}]
		set fileList [lreplace $fileList $index $index]	;# drop tmp - useful for ConvertPRN2PDF (in iconet.com.br/banon/2006/01.28.22.05)
		if [regexp "$URLibServiceRepository/doc$" $dir] {	;# added by GJFB on 2020-04-18
			set index [lsearch -exact $fileList {progressDir}]
			set fileList [lreplace $fileList $index $index]	;# drop progressDir - useful for Tcl Page
		}
		if {$flag && [llength $fileList] > 2000} {
			cd $pwd
			return {}
		}
		foreach file $fileList {
# problem with a file named:
# ~$unzip.doc
# we get the message:
# user "$unzip.doc" doesn't exist
# when running [file isdirectory $file]
# with $file == ~$unzip.doc
#
# this problem occurs with 8.0 and not with 8.3
## for that reason we put a catch
			if [file isdirectory $file] {
				set time [DirectoryMTime [file join $dir $file] $flag $time $alternateTargetFile]
			} else {
#				if ![file exists ./$file] {continue}	;# accent problem after migration (for example from Windows) - glob might recognize some accent that the operational system might not (e.g., glob may recognize Portugu??sLanguage.tcl as PortuguêsLanguage.tcl - this last name is not recognized by the operational system)
				set properytList [ReturnFileProperties $dir/$file mtime]	;# added by GJFB on 2015-01-14 to solve the accent problem (see ReturnFileProperties)
				array set propertyArray $properytList
				if [string equal {} $time] {
#					set time [file mtime ./$file]	;# ./ is needed in a case like ~$unzip.doc
					set time $propertyArray(mtime)
				} else {
#					set time [Max $time [file mtime ./$file]]	;# ./ is needed in a case like ~$unzip.doc
					set time [Max $time $propertyArray(mtime)]
				}
			}
		}
		cd $pwd
		return $time
	}
}
# puts [DirectoryMTime "c:/Users/Gerald Banon/URLib 2/col/dpi.inpe.br/banon-pc3@80/2009/11.10.13.03/doc"]
# puts [DirectoryMTime c:/tmp]
		
# DirectoryMTime - end
# ----------------------------------------------------------------------
# RepositoryMTime
# flag == 0 means no limit for the number of files
# (see DirectoryMTime)
# returns the most recent mtime among the doc part of the current repository
# and among the doc part of all its parents (if any)

proc RepositoryMTime {rep homePath {flag 0}} {
# runs with post
	set repList [CreateCitedRepositoryList $rep]
	lappend repList $rep
	set max 0
	foreach repository $repList {
		Load $homePath/col/$repository/service/targetFile targetFile
		set seconds [DirectoryMTime $homePath/col/$repository/doc $flag 0 @$targetFile]
		if {$seconds == {}} {continue}
		set max [Max $max $seconds]
		set seconds [DirectoryMTime $homePath/col/$repository/agreement $flag]	;# added by GJFB on 2011-10-01
		if {$seconds == {}} {continue}
		set max [Max $max $seconds]
	}
	return $max
}

# RepositoryMTime - end
# ----------------------------------------------------------------------
# StringMin
# Find the min of two string
# example:
# StringMin 2000.01.15 2000.01.16
# used in Statistics (statistics.tcl)

proc StringMin {x y} {
	set i [string compare $x $y]
	if {$i == -1} {return $x} else {return $y}
}

# puts [StringMin 2000.01.15 2000.01.16]
# => 2000.01.15

# StringMin - end
# ----------------------------------------------------------------------
# Store
# Store to the disk the value of a tcl variable
# force value is 0 or 1; 1 means to force storage even for a
# read only site (used to store the Apache configuration files)
# example:
# Store referMetadata $homePath/col/$metadataRep/doc/@metadata.refer auto 0 w 0 iso8859-1
# encodingName is used in Submit (see '# STORE METADATA' in submit.tcl), urlibScript/getWordOccurrence.tcl and DisplayNumberOfEntries only

proc Store {
	varName filePath {translation auto} {nonewline 0} {access w} {force 0}
	{encodingName {}} {numberOfTrials 1}
} {
#	global env
#	global homePath
	
if 0 {
	if {[info exists env(DOCUMENT_ROOT)] && \
	[file exists $env(DOCUMENT_ROOT)/readOnlySite] && \
	!$force} {return}
	if {[info exists homePath] && \
	[file exists $homePath/readOnlySite] && \
	!$force} {return}
}
	upvar $varName var
	
	if [catch {open $filePath $access} fileId] {
		if {$numberOfTrials < 10} {
			if [info exists x] {unset x}
			after 100 {set x 1}; vwait x	;# wait 100 ms
			incr numberOfTrials
#			Store $varName $filePath $translation $nonewline $access $force $numberOfTrials
			Store var $filePath $translation $nonewline $access $force $encodingName $numberOfTrials	;# fixed by GJFB on 2010-08-04
		} else {
#			puts "Store: cannot open $filePath $access: $fileId"
#			puts stderr $fileId	;# give up - this command results in the error: "can not find channel named "stderr"" while executing CreateTclPage. It should be commented or catched
			catch {puts stderr $fileId}	;# give up
		}
	} else {
		if [string equal {} $encodingName] {
			fconfigure $fileId -translation $translation
		} else {
			fconfigure $fileId -translation $translation -encoding $encodingName
		}
		if [info exists var] {	;# if added by GJFB on 2022-11-03 to avoid, when using Store, errors like: can't read "var": no such variable and turn Store dual of Load
			if $nonewline {
				puts -nonewline $fileId $var
			} else {
				puts $fileId $var
			}
		} else {
# added by GJFB on 2022-11-03
			set var2 {}
			puts -nonewline $fileId $var2	;# added by GJFB on 2022-11-03 - an empty file is created
		}
		close $fileId
	}
}

# Store - end
# ----------------------------------------------------------------------
# StoreWithBackup
# example: StoreWithBackup fileContent $col/$loBiMiRep/doc/@siteList.txt
# stores in:
# $col/$loBiMiRep/doc/@siteList.txt and
# $col/$loBiMiRep/doc/@siteListBackup.txt 

proc StoreWithBackup {varName filePath {translation auto} {nonewline 0} {access w}} {
	upvar $varName var
	
	set backupPath [file rootname $filePath]Backup[file extension $filePath]
	Store var $backupPath $translation $nonewline $access	;# backup - if this store fails because the computer stops, file with filePath remains unchanged
#	Store var $filePath $translation $nonewline $access	;# if this store fails because the computer stops, file with backupPath can be used as backup
	file copy -force $backupPath $filePath	;# if this copy fails because the computer stops, file with backupName can be used as backup
}

# StoreWithBackup - end
# ----------------------------------------------------------------------
# Grep
# pattern is a regular expression
# nocase value is {} or -nocase

proc Grep {pattern inputList {nocase {}}} {
	set outputList ""
	regsub -all {\.} $pattern {\.} pattern	;# . -> \.
	regsub -all {\?} $pattern {\?} pattern	;# ? -> \?
#	regsub -all {\(} $pattern {\(} pattern	;# ( -> \(
#	regsub -all {\)} $pattern {\)} pattern	;# ) -> \)
	foreach listElement $inputList {
#		if [catch {eval regexp $nocase -- $pattern $listElement} flag] {break}	;# couldn't compile regular expression pattern: parentheses () not balanced
#		if [catch {eval regexp $nocase -- $pattern [list $listElement]} flag] {break}	;# couldn't compile regular expression pattern: parentheses () not balanced
		if [catch {eval regexp $nocase -- [list $pattern $listElement]} flag] {break}	;# couldn't compile regular expression pattern: parentheses () not balanced
#		if [catch {eval [list regexp $nocase -- $pattern $listElement]} flag] {break}	;# couldn't compile regular expression pattern: parentheses () not balanced
		if $flag {
			lappend outputList $listElement
		}
	}
	return $outputList
}

# puts [Grep {^b} {bs b absi wsr bba}]
# => bs b bba
# puts [Grep {^?} {bs b ?absi wsr bba}]
# => ?absi

# Grep - end
# ----------------------------------------------------------------------
# TestContentType
# type value is:
# Access Icon or
# Banner (@enBanner.html|@pt-BRBanner.html) or
# Banner Sequence or
# Bibliography Data Base (@reference.bib) or
# Copyright or
# External Contribution (used in ComputeVersionState (utilitiesStart.tcl)) or
# Index or
# Metadata (metadata.cgi) or
# Mirror (mirror.cgi) or others

proc TestContentType {rep type {colPath {}}} {
# runs with post and cgi
	global repositoryProperties
	
	if [info exists repositoryProperties] {
# post
		if [info exists repositoryProperties($rep,type)] {
			set contentType $repositoryProperties($rep,type)
		} else {
#			set contentType {}	;# commented by GJFB on 2018-12-25
			Load $colPath/col/$rep/service/type contentType	;# added by GJFB on 2018-12-25 - now needed in UpdateCollection only
		}
	} else {
# cgi
		Load $colPath/col/$rep/service/type contentType
	}
	return [regexp ^$type$ $contentType]
}

# TestContentType - end
# ----------------------------------------------------------------------
# CreateAbbreviation
# pattern example: ^v
# field::conversionTable is in col/dpi.inpe.br/banon/1999/05.03.22.11/doc/mirror/enFieldName.tcl

proc CreateAbbreviation {pattern} {
	global abbreviationArray
	
	set fieldList [array names field::conversionTable ?*]	;# ?* to drop {}
	set fieldList [Grep $pattern $fieldList]
	foreach field $fieldList {
		set firstLetters [ExtractFirstCharacters fieldList $field]
		set abbreviationArray($field) $firstLetters
	}
	return $fieldList
}

# CreateAbbreviation - end
# ----------------------------------------------------------------------
# ExtractFirstCharacters
# Extract the first significant characters of a pattern of a list
# used in CreateAbbreviation (see mirrot.tcl) and StartService

proc ExtractFirstCharacters {listName pattern} {
	upvar $listName list
	set list2 $list
	set i 0
	set firstLetters ""
	while {[llength $list2] > 1} {
		if {[string compare $firstLetters $pattern] == 0} {
			set firstLetters $pattern,
			break
		}
		set firstLetters [string range $pattern 0 $i]
		regsub -- {-$} $firstLetters {} firstLetters	;# because of e-mail address
		set list2 [Grep ^$firstLetters $list2]
		incr i
	}
	return $firstLetters
}

if 0 {
source ../../../1999/05.03.22.11/doc/mirror/enFieldName.tcl
foreach {index value} [array get field::conversionTable] {
	set inverseTable($value) $index
}
set fieldList [array names field::conversionTable ?*]	;# ?* to drop {}
foreach value [lsort -dictionary [array names inverseTable ?*]] {
set firstLetters [ExtractFirstCharacters fieldList $inverseTable($value)]
	puts $inverseTable($value)
	puts $firstLetters
}
puts [ExtractFirstCharacters fieldList academicdepartment]
# => aca
}

# ExtractFirstCharacters - end
# ----------------------------------------------------------------------
# GetAccessDate

proc GetAccessDate {accessDate} {
#	set seconds [GetSeconds]
	set seconds [clock seconds]
	set year [clock format $seconds -format %Y]
	set month [clock format $seconds -format %b]
	set day [clock format $seconds -format %d]
	return [subst $accessDate]
}

# GetAccessDate - end
# ----------------------------------------------------------------------
# GetStatisticsDate

proc GetStatisticsDate {statisticsDate} {
	global env
	if [file exists $env(DOCUMENT_ROOT)/col/$env(LOBIMIREP)/doc/@wordOccurrence] {
		set seconds [file mtime $env(DOCUMENT_ROOT)/col/$env(LOBIMIREP)/doc/@wordOccurrence]
	} else {
#		set seconds [GetSeconds]
		set seconds [clock seconds]
	}
	set year [clock format $seconds -format %Y]
	set month [clock format $seconds -format %b]
	set day [clock format $seconds -format %d]
	return [subst $statisticsDate]
}

# GetStatisticsDate - end
# ----------------------------------------------------------------------
# GetSeconds
# not used

proc GetSeconds2 {} {
# runs with start and post
	global environmentArray
	set seconds [clock seconds]
	if {[info exists environmentArray(spDaylightTime)] && \
		$environmentArray(spDaylightTime)} {
		set seconds [expr $seconds + 3600]
	}
	return $seconds
}

# GetSeconds - end
# ----------------------------------------------------------------------
# ReturnTimeOutReference

proc ReturnTimeOutReference {} {
	global tcl_platform
	
	if [string equal {windows} $tcl_platform(platform)] {
		return [expr int(333 * 6)]	;# 1 / 3 second * 6 (gabriela using Get (when calling ResolveIBI to find the appropriate metadata repository))
	} else {
		return [expr int(333 * 3)]	;# 1 / 3 second * 3 (because of mtc-m17 when searching for ar cea and y 2007)
	}
}

# ReturnTimeOutReference - end
# ----------------------------------------------------------------------
# Submit

proc Submit {sock line {async 1} {clicks {}}} {
#	global x y	;# for unix
	global eval
	global errorTrace	;# set in post and start
	global homePath
	global installInitialCollection

# set errorTrace 1
	 
	if [string equal {} $clicks] {set clicks [clock clicks]}
if {[info exists errorTrace] && $errorTrace} {
# 1
	set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Submit (1 - $sock - $clicks): beginning communication with the server: $eval(server,$sock)\nthe query is: $line\nasync value is: $async\n"
	Store log $homePath/@errorLog auto 0 a
	Store log $homePath/@executeLog$clicks auto 0 a
}

	if $async {
		set command [lindex $line 0]
# timeOut
		set timeOut [ReturnTimeOutReference]
# timeOutArray
		set timeOutArray(GetEntry) [expr 4 * $timeOut]	;# time out reference is not enought to display some entries using GetEntry (in LoopOverEntries) - mtc-m13.sid.inpe.br - sid.inpe.br/jeferson/2004/09.17.11.26 - 41225 Kbytes
		set timeOutArray(UpdateHostCollectionFieldValue) [expr 4 * $timeOut]	;# time out reference is not enought when migrating from one local collection to another
		set timeOutArray(BuildReturnPathArray) [expr 4 * $timeOut]	;# set to 4 to let remote BuildReturnPathArray return non empty value when called recursively in BuildReturnPathArray called in Get
# timeOut2
		ConditionalSet timeOut2 timeOutArray($command) $timeOut

		global x$clicks
		if [info exists x$clicks] {unset x$clicks}
		fileevent $sock writable "set x$clicks 0"
#		after $timeOut2 "set x$clicks 1"
#		after 100 "set x$clicks 1"	;# 100 ms - after 100 ms produces an unaccessible reference
		after 200 "set x$clicks 1"	;# 200 ms - after 200 ms produces an unaccessible reference (200 ms is to access mtc-m17 from banon-pc2 at home)
		vwait x$clicks
if {[info exists errorTrace] && $errorTrace} {
# 2
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Submit (2 - $sock - $clicks): testing if $sock is writable\nx$clicks value is: [set x$clicks]\n"
		Store log $homePath/@errorLog auto 0 a
		Store log $homePath/@executeLog$clicks auto 0 a
}

		if [set x$clicks] {
			close $sock
			return -code error -errorinfo "writing time out at $eval(server,$sock)"
#			return -code return -errorinfo {writing time out}
		}
		unset x$clicks	;# free memory
	}
# set xxx Submit(1)-$clicks
# Store xxx C:/tmp/bbb.txt binary 0 a

	if [string equal {ComputeAccess} [lindex $line 0]] {
		puts $sock $line
#		flush $sock	;# not needed  because of fconfigure $s -buffering line (in StartCommunication)
# Read return line count and the result.
		gets $sock lines
		set result {}
		while {$lines > 0} {
			gets $sock x
			append result $x\n
			incr lines -1
		}
		set code [lindex $result 0]
		set x [lindex $result 1]
# Cleanup the end of the stack
		regsub "\[^\n]+$" [lindex $result 2] "*Remote Server $eval(server,$sock)*" stack
		set ec [lindex $result 3]
		return -code $code -errorinfo $stack -errorcode $ec $x
	} else {
# Clear channel
# to test these codes, uncomment the line with the comment: clearing channel (see ReturnSiteContainingTheOriginal in utilitiesStart.tcl and FindSiteContainingTheOriginal in this file)
# none of the codes below are completly satisfactory

if 0 {
		global y
		if [info exists y] {unset y}
		fileevent $sock readable {set y 1}
		after 100 {set y 0}	;# it is assumed that the channel can be cleared in 100 ms
		vwait y
		if $y {gets $sock garbage}
} else {
		fconfigure $sock -blocking 0
		gets $sock garbage
		fconfigure $sock -blocking 1
}
# Clear channel - end

if {[info exists errorTrace] && $errorTrace} {
# 3
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Submit (3 - $sock - $clicks): putting the query to $sock\n"
		Store log $homePath/@errorLog auto 0 a
		Store log $homePath/@executeLog$clicks auto 0 a
}

# set xxx Submit(2)-$clicks
# Store xxx C:/tmp/bbb.txt binary 0 a

		puts $sock $line
		
# set xxx Submit(3)-$clicks
# Store xxx C:/tmp/bbb.txt binary 0 a

if {[info exists errorTrace] && $errorTrace} {
# 4
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Submit (4 - $sock - $clicks): the query has been put to $sock\n"
		Store log $homePath/@errorLog auto 0 a
		Store log $homePath/@executeLog$clicks auto 0 a
}

# set xxx "$clicks 2"
# Store xxx C:/tmp/bbb.txt binary 0 a

		if 1 {
# must be 1 otherwise gets below hangs, for example, when Submit is called from Execute within Info within UpdateAccessFile within InstallRepository within Run-ir
#		if $async #
#			set y 0	;# doesn't work properly with this line (mosaic)
#			after 1000 {set y 1}; vwait y

			global y$clicks
			global yclicks	;# used only in cgi/test2 - added by GJFB on 2025-10-04 to test readable socket
			if [info exists y$clicks] {unset y$clicks}
			fileevent $sock readable "set y$clicks 0"	;# otherwise hangs when displaying all entries (and others)
			if $async {after $timeOut2 "set y$clicks 1"}	;# doesn't work properly (vwait below hangs) when the command is PostponeOneClickCount (issuing a rep-) and the ip is 127.0.0.1 in a wrong way

if {[info exists installInitialCollection] && $installInitialCollection} {
# added by GJFB on 2021-07-09
			set i 0
			while {![info exist y$clicks]} {
				set x 0; after 1 {set x 10}; vwait x
				incr i
				if {$i > 1600} {
# time-out (16 seconds required running start from external HD SAMSUNG (D:))
					close $sock
#					return -code error -errorinfo "Submit (1): reading time out at $eval(server,$sock)"
					return -code error "Submit (1): reading time out at $eval(server,$sock)"
				}
			}
} else {
#			after $timeOut2 "set y$clicks 1"
# set xxx Submit(4)-$clicks
# Store xxx C:/tmp/bbb.txt binary 0 a
			vwait y$clicks
# set xxx Submit(5)-$clicks
# Store xxx C:/tmp/bbb.txt binary 0 a
}
			if $async {after cancel "set y$clicks 1"}

if {[info exists errorTrace] && $errorTrace} {
# 5
			set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Submit (5 - $sock - $clicks): testing if $sock is readable\ny$clicks value is: [set y$clicks]\n"
			Store log $homePath/@errorLog auto 0 a
			Store log $homePath/@executeLog$clicks auto 0 a
}
			set yclicks [set y$clicks]	;# used only in cgi/test2 - added by GJFB on 2025-10-04 to test readable socket
			if [set y$clicks] {
# time-out
				close $sock
#				return -code error -errorinfo "Submit (2): reading time out at $eval(server,$sock)"
				return -code error "Submit (2): reading time out at $eval(server,$sock)"
			}
			unset y$clicks	;# added by GJFB on 2013-07-19 - free memory
# tcl didn't receive a readable event after StartApacheServer was
# executed when running under UNIX platform (see CreateRepMetadataRep)
		}
#		global y
#		fileevent $sock readable "set y 0"; vwait y	;# otherwise hangs when displaying all
if {[info exists errorTrace] && $errorTrace} {
# 6
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Submit (6 - $sock - $clicks): getting the reply from $sock\n"
		Store log $homePath/@errorLog auto 0 a
		Store log $homePath/@executeLog$clicks auto 0 a
		if [regexp {^Run-exit \d+} $line] {file delete $homePath/@executeLog$clicks}
}

		gets $sock line
		
# set xxx [list $sock $line]
# Store xxx C:/tmp/bbb.txt auto 0 a
# puts [list $sock eof = [eof $sock] <BR>]
if {[info exists errorTrace] && $errorTrace} {
# 7
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Submit (7 - $sock - $clicks): returning the reply: $line\n"
		Store log $homePath/@errorLog auto 0 a
		file delete $homePath/@executeLog$clicks
}
# set xxx "$clicks 3"
# Store xxx C:/tmp/bbb.txt binary 0 a
#		unset eval	;# added by GJFB on 2013-07-19
#		if [info exists eval] {unset eval}	;# added by GJFB on 2013-07-19 - free memory - commented by GJFB on 2017-03-17 to avoid deleting data of other running processes (otherwise, for example, gjfb.home:1905/8JMKD3MGP3W34P/3NFKNR8 doesn't return the identified item an Journal Article) because GetReply return immediatly (see the first two "if") and no reply is created)
		if [info exists eval(server,$sock)] {unset eval(server,$sock)}	;# added by GJFB on 2017-03-17 to avoid deleting data of other running processes - same coder as in CleanUp
		if [info exists eval(token,$sock)] {unset eval(token,$sock)}	;# added by GJFB on 2017-03-17 to avoid deleting data of other running processes - same coder as in CleanUp

		return $line
	}
}

# Submit - end
# ----------------------------------------------------------------------
# Execute
# site may coded in any form (e.g., banon-pc3 or banon-pc3:80 or {banon-pc3 800} or 153.163.2.174 or 153.163.2.174:80 or {153.163.2.174 800})
# if site is not a virtual host, otherwise just the new coding is allowed (e.g., {banon-pc3 802} or {153.163.2.174 802})
# example:
# set metadata2List [Execute $serverAddressWithIP [list GetMetadata $callingRep-0,metadatalastupdate]]
# encodingName value is for example iso8859-1 or utf-8
## utf-8 is used in FindAbsolutePath (not more in use) when executing GetTargetFile (in the communication with plutao)
## doesn't work when opening sid.inpe.br/mtc-m15@80/2006/12.06.11.48 (located at mtc-m15)
##		set targetFile [Execute $serverAddress2 [list GetTargetFile $currentRep] 1 utf-8]	;# solves the accent problem - communication from banon-pc3 to plutao - see Get- - done by GJFB on 2010-07-09
## returning to old code - done by GJFB on 2010-10-26	
## works with http://banon-pc3/rep/dpi.inpe.br/plutao@80/2009/07.13.14.44
## works when opening sid.inpe.br/mtc-m15@80/2006/12.06.11.48 (located at mtc-m15)
##		set encodingName [Execute $serverAddress2 [list GetEncodingName]]
##		set targetFile [Execute $serverAddress2 [list GetTargetFile $currentRep] 1 $encodingName]
# returnEmptyFlag value is 0 or 1,
# 1 means to return empty when the communication with the server (site) doesn't start
# 0 means to produce an error

proc Execute {site command {async 1} {encodingName {}} {returnEmptyFlag 0}} {
	global env
	global errorTrace	;# set in post
	global homePath
	global serverAddress
	global serverAddressWithIP
	global errorInfo

	set clicks [clock clicks]
	if $async {
		if {[info exists env(SERVER_NAME)] && [info exists env(IP_ADDR)]} {
# the calling procedure is a cgi script
			set async2 [ResolveAsync $env(SERVER_NAME) $env(IP_ADDR) $site]
		} else {
# the calling procedure is not a cgi script
			if [info exists serverAddress] {
				set async2 [ResolveAsync [lindex $serverAddress 0] [lindex $serverAddressWithIP 0] $site]
			} else {
# case of processMail (newpassword@dpi.inpe.br) - not used anymore
				set async2 1
			}
		}
	} else {
		set async2 0
	}
# puts ">>>$site $command"
# puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
	foreach {serverName urlibPort} [ReturnCommunicationAddress $site] {break}
# sometimes the serverName may be 127.0.0.1 in a wrong way
# this already occured after a breakdown (with marte)
# it was not possible to solve this problem in Submit because vwait hangs
	if {[string equal {127.0.0.1} $serverName] && [info exists serverAddressWithIP] && ![regexp {127.0.0.1} $serverAddressWithIP]} {return}
if {[info exists errorTrace] && $errorTrace} {
# 1
	set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Execute (1 - $clicks): starting communication with the server (using async value $async2): \[$serverName $urlibPort\]\n"
	Store log $homePath/@errorLog auto 0 a
	Store log $homePath/@executeLog$clicks auto 0 a
}
# START COMMUNICATION
#	set x 0; after 100 {set x 1}; vwait x	;# nice procedure - needed to recreate .keyRepositoryList.tcl in gabriela
# puts OK
# puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
	if [catch {StartCommunication $serverName $urlibPort $async2 $encodingName} localURLibClientSocketId] {
# puts OK-
# puts --$localURLibClientSocketId--
# puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
# return
if {[info exists errorTrace ] && $errorTrace} {
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Execute (2 - $clicks): communication with server \[$serverName $urlibPort\] doesn't start: --$localURLibClientSocketId--\n"
		Store log $homePath/@errorLog auto 0 a
		file delete $homePath/@executeLog$clicks auto 0 a
}
		if $returnEmptyFlag {return}	;# added by GJFB on 2013-02-24 in order to continue executing CreateOptionListForCopyright even though the communication with a server doesn't start
#		return -code error -errorinfo "Execute (3): communication with server \[$serverName $urlibPort\] doesn't start while trying to execute the command:\n$command\n"
		error "Execute (3): communication with server \[$serverName $urlibPort\] doesn't start (using async value $async2) while trying to execute the command:\n$command\nerrorInfo:\n--$errorInfo--\n"
	}
# Store localURLibClientSocketId C:/tmp/bbb.txt auto 0 a
# puts OK2
# puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed

#	set output [Submit $localURLibClientSocketId $command $async2]
if {[info exists errorTrace] && $errorTrace} {
# 4
	set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Execute (4 - $clicks): submitting the following command to $localURLibClientSocketId:\n$command\n"
	Store log $homePath/@errorLog auto 0 a
	Store log $homePath/@executeLog$clicks auto 0 a
}
# SUBMIT
	if [catch {Submit $localURLibClientSocketId $command $async2 $clicks} output] {
		catch {close $localURLibClientSocketId}	;# added by GJFB on 2012-12-29
#		set message [StoreLog {alert} {Execute (5)} "catch returns --$output-- while executing: \"Submit $localURLibClientSocketId $command $async2 $clicks\"\n"]	;# commented by GJFB on 2025-10-04
		set message [StoreLog {alert} {Execute (5)} "catch returns --$output-- while executing: \"Submit $localURLibClientSocketId $command $async2 $clicks\"\n[CallTrace]\n"]	;# added by GJFB on 2025-10-04

#		puts $message
		return	;# if time out, return empty
	}
	close $localURLibClientSocketId
# Store localURLibClientSocketId C:/tmp/bbb.txt auto 0 a
# puts +++$output+++
	return $output
}

# Execute - end
# ----------------------------------------------------------------------
# ResolveAsync

proc ResolveAsync {serverName ipAddress site} {
	upvar command command
	if [regexp -nocase "$serverName|$ipAddress" $site] {
# the call is to the local computer
		set async 0	;# needed with submit.tcl (CreateRepMetadataRep and UpdateRepMetadataRep)
	} else {
# the call is to a remote computer
		set command2 [lindex $command 0]
# asyncArray
		set asyncArray(CreateRepMetadataRep) 0	;# used in Submit (see submit.tcl)
		set asyncArray(UpdateRepMetadataRep) 0	;# used in Submit (see submit.tcl)
#		set asyncArray(FindMetadataRep) 0	;# used in Submit (see submit.tcl)
		ConditionalSet async asyncArray($command2) 1
	}
	return $async
}

# ResolveAsync - end
# ----------------------------------------------------------------------
# Eval
# example:
# Eval UpdateVariables $metadataRep
# used by UpdateRobotstxtFile (called in cgi/script - Administrator Page)

proc Eval {args} {
# runs with start and post
	global serverAddressWithIP
	global applicationName

	if {![info exists applicationName] || $applicationName == "start"} {
		return [Execute $serverAddressWithIP $args 0]	;# not async
	} else {
		return [eval $args]
	}
}

# Eval - end
# ----------------------------------------------------------------------
# CompareKey
# not used

proc CompareKey2 {a b} {
	set a1 [lindex $a 1]
	set b1 [lindex $b 1]
	return [string compare $a1 $b1]
}

# CompareKey - end
# ----------------------------------------------------------------------
# CompareDate-
# compares based on rep-i

proc CompareDate- {a b} {
	set a3 [lrange [file split [lindex $a 3]] 2 3]
	set b3 [lrange [file split [lindex $b 3]] 2 3]
	return [string compare $a3 $b3]
}

# CompareDate- - end
# ----------------------------------------------------------------------
# CompareDate+
# compares based on rep-i

proc CompareDate+ {a b} {
	set a3 [lrange [file split [lindex $a 3]] 2 3]
	set b3 [lrange [file split [lindex $b 3]] 2 3]
	return [string compare $b3 $a3]
}

# CompareDate+ - end
# ----------------------------------------------------------------------
# CompareStamp

proc CompareStamp {a b} {
	set a20 [lindex [lindex $a 2] 0]	;# metadataLastUpdate
	set b20 [lindex [lindex $b 2] 0]	;# metadataLastUpdate
	return [string compare $b20 $a20]
}

# CompareStamp - end
# ----------------------------------------------------------------------
# CompareLastUpdateStamp

proc CompareLastUpdateStamp {a b} {
	set a50 [lindex [lindex $a 5] 0]	;# lastUpdate
	set b50 [lindex [lindex $b 5] 0]	;# lastUpdate
	return [string compare $b50 $a50]
}

# CompareLastUpdateStamp - end
# ----------------------------------------------------------------------
# CompareStamp2
# use by ReturnURLPropertyList only

proc CompareStamp2 {a b} {
	set a20 [lindex [lindex [lindex $a 1] 0] 0]	;# metadataLastUpdate
	set b20 [lindex [lindex [lindex $b 1] 0] 0]	;# metadataLastUpdate
	return [string compare $b20 $a20]
}

# CompareStamp2 - end
# ----------------------------------------------------------------------
# CompareStampRep-i
# a and b are lists: site key metadataLastUpdate rep-i state

proc CompareStampRep-i {a b} {
	if [catch {lindex $a 2} a2] {return 1}	;# metadataLastUpdate
	set a23 [lappend a2 [lindex $a 3]]	;# metadataLastUpdate rep-i
	if [catch {lindex $b 2} b2] {return 1}	;# metadataLastUpdate
	set b23 [lappend b2 [lindex $b 3]]	;# metadataLastUpdate rep-i
	return [string compare $b23 $a23]
}

# CompareStampRep-i - end
# ----------------------------------------------------------------------
# CompareStampRep-iState
# a and b are lists: site key metadataLastUpdate rep-i state
# [lindex $a 4] == state variable of GetMetadataRepositories
# [lindex $b 4] == state variable of GetMetadataRepositories
# state is 1 if the repository contains the original and 0 otherwise

proc CompareStampRep-iState {a b} {
	set test [CompareStampRep-i $a $b]
	if {$test == 0} {
		return [expr [lindex $a 4] < [lindex $b 4]]
	}
	return $test
}

# CompareStampRep-iState - end
# ----------------------------------------------------------------------
# CompareKeyTitle
# created by GJFB on 2013-10-15
# a and b are lists: site key metadataLastUpdate rep-i state
# [lindex $a 1] == key variable of GetMetadataRepositories
# [lindex $b 1] == key variable of GetMetadataRepositories
# [lindex $a 5] == sortedFieldValue variable of GetMetadataRepositories
# [lindex $b 5] == sortedFieldValue variable of GetMetadataRepositories

proc CompareKeyTitle {a b} {
	set a1 [lindex $a 1]	;# key (citation key)
	set b1 [lindex $b 1]	;# key (citation key)
	set test [string compare $a1 $b1]
	if {$test == 0} {
		set a5 [lindex $a 5]	;# sortedFieldValue (e.g., title)
		set b5 [lindex $b 5]	;# sortedFieldValue (e.g., title)
#		return [string compare $a5 $b5]	;# doesn't produce a dictionary-style comparison
		return [expr [lindex [lsort -dictionary -indices [list $a5 $b5]] 1] * 2 - 1]
	}
	return $test
}

# CompareKeyTitle - end
# ----------------------------------------------------------------------
# CompareSortedField
# created by GJFB on 2021-02-05
# a and b are lists: site key metadataLastUpdate rep-i state sortedFieldValue
# [lindex $a 5] == sortedFieldValue variable of GetMetadataRepositories
# [lindex $b 5] == sortedFieldValue variable of GetMetadataRepositories

proc CompareSortedField {a b} {
	set a5 [lindex $a 5]	;# sortedFieldValue (shorttitle)
	set b5 [lindex $b 5]	;# sortedFieldValue (shorttitle)
	return [string compare $a5 $b5]
}

# CompareSortedField - end
# ----------------------------------------------------------------------
# CompareYearKeyTitle
# created by GJFB on 2014-08-10
# a and b are lists: site key metadataLastUpdate rep-i state sortedFieldValue
# [lindex $a 1] == key variable of GetMetadataRepositories
# [lindex $b 1] == key variable of GetMetadataRepositories
# [lindex $a 5] == sortedFieldValue variable of GetMetadataRepositories
# [lindex $b 5] == sortedFieldValue variable of GetMetadataRepositories

proc CompareYearKeyTitle {a b} {
	set a1 [lindex $a 1]	;# key (citation key)
	set b1 [lindex $b 1]	;# key (citation key)
	if ![regexp {:(\d{4,}):} $a1 m yeara] {set yeara 0}
	if ![regexp {:(\d{4,}):} $b1 m yearb] {set yearb 0}
	set test1 [string compare $yearb $yeara]
	if {$test1 == 0} {
		set test2 [string compare $a1 $b1]
		if {$test2 == 0} {
			set a5 [lindex $a 5]	;# sortedFieldValue (e.g., title)
			set b5 [lindex $b 5]	;# sortedFieldValue (e.g., title)
			return [expr [lindex [lsort -dictionary -indices [list $a5 $b5]] 1] * 2 - 1]
		}
		return $test2
	}
	return $test1
}

# CompareYearKeyTitle - end
# ----------------------------------------------------------------------
# CompareDateYearKey
# created by GJFB on 2016-03-14
# a and b are lists: site key metadataLastUpdate rep-i state sortedFieldValue
# [lindex $a 1] == key variable of GetMetadataRepositories
# [lindex $b 1] == key variable of GetMetadataRepositories
# [lindex $a 5] == sortedFieldValue variable of GetMetadataRepositories
# [lindex $b 5] == sortedFieldValue variable of GetMetadataRepositories

proc CompareDateYearKey {a b} {
	set a5 [lindex $a 5]	;# sortedFieldValue (date or issuedate)
	set b5 [lindex $b 5]	;# sortedFieldValue (date or issuedate)
# puts [list $a5 $b5]	;# the output is at the bottom of the web page
	if ![regexp {^\d{4,}.*} $a5 datea] {set datea 0}
	if ![regexp {^\d{4,}.*} $b5 dateb] {set dateb 0}
	set test1 [string compare $datea $dateb]
	if {$test1 == 0} {
		set a1 [lindex $a 1]	;# key (citation key)
		set b1 [lindex $b 1]	;# key (citation key)
		if ![regexp {:(\d{4,}):} $a1 m yeara] {set yeara 0}
		if ![regexp {:(\d{4,}):} $b1 m yearb] {set yearb 0}
		set test2 [string compare $yeara $yearb]
		if {$test2 == 0} {
			return [expr [lindex [lsort -dictionary -indices [list $b1 $a1]] 1] * 2 - 1]
		}
		return $test2
	}
	return $test1
}

if 0 {
# commented by GJFB n 2018-02-26
# not used
proc CompareDateKey {a b} {
	set a5 [lindex $a 5]	;# sortedFieldValue (date or issuedate)
	set b5 [lindex $b 5]	;# sortedFieldValue (date or issuedate)
# puts [list $a5 $b5]	;# the output is at the bottom of the web page
	if ![regexp {^\d{4,}.*} $a5 datea] {set datea 0}
	if ![regexp {^\d{4,}.*} $b5 dateb] {set dateb 0}
	set test2 [string compare $datea $dateb]
	if {$test2 == 0} {
		set a1 [lindex $a 1]	;# key (citation key)
		set b1 [lindex $b 1]	;# key (citation key)
		return [expr [lindex [lsort -dictionary -indices [list $b1 $a1]] 1] * 2 - 1]
	}
	return $test2
}
}
# CompareDateYearKey - end
# ----------------------------------------------------------------------
# LoopOverEntries
# called by CreateOutput below only
# flag value is 0 or 1
# 1 means that the number of entries found is greater than the specified maximum
# path example: ../
# numbering values are {} or {numbering prefix}; {} means to do no numbering
# outputFormat values are boolean or {html code} or a list of field names; used by briefTitleAuthorMisc and CreateDateTitleSite - default is used by briefTitleAuthorMisc
# cellBackgroundColors value is a list of two colors; for example: {#EEEEEE #E3E3E3}; used by CreateDateTitleSite
# pageFlag values are no or yes; used by CreateBriefTitleAuthorEntry
# includeReturnAddress values are yes or no; set in GetSearchResult and used in CreateBriefEntry (see update link)
# linkType used by CreateBriefTitleAuthorEntry (see CreateBriefTitleAuthorEntry)
# hideSimilarButton set in CreateOutput and used by CreateBriefEntry
# type is the output format, for example: brief
# targetValue is for example _blank, _self, ...
# dateFieldName is metadatalastupdate or issuedate (used by CreateDateTitleSite)
# siteFieldName is site or newspaper (used by CreateDateTitleSite)
# returnButton value is no or yes
# nameFormat value is short, familynamefirst or familynamelast (used by CreateBriefTitleAuthorEntry)
# nameSeparator value is a string like {; } or {<BR>} (used by CreateBriefTitleAuthorEntry)
# originalRepForSimilarity value is a rep-i or empty
# imageFlag value is 0 or 1; 1 means to display the thumbnail (if any) - used by CreateFullEntry only
# alternateQuery value is empty or the content of the second query field
# queryFieldType value is first or second
# searchInputValue is a search expression - set in URL (used in mirrorHomePage.html, CreateMirror, LoopOverEntries, GetEntry and CreateBriefEntry)
# childIdentifier (ex: mirrorIdentifier) is an IBIp or IBIn - set in MirrorSearch and used in CreateBriefEntry
# forceRecentFlag value is 0 (default) or 1 - 1 set in MirrorRecent is used to return to 'The most Recent' after clicking in Return (<) in the horizontal upper menu (see Get)
# forceHistoryBackFlag value is 0 or 1 (default) - 0 set in CreateMirror and 1 set in Get, both are used in mirror/xxCover.tcl

proc LoopOverEntries {
	query2String type numberOfEntries top path header
	excludedFields {flag 0} {numbering {}} {outputFormat 1}
	{cellBackgroundColors {#EEEEEE #E3E3E3}} {pageFlag no}
	{includeReturnAddress yes} {linkType 0} {hideSimilarButton {no}}
	{targetValue _blank} {dateFieldName metadatalastupdate}
	{siteFieldName site} {returnButton no} {cssFileURL {}}
	{nameFormat {short}} {nameSeparator {; }} {originalRepForSimilarity {}}
	{imageFlag 1} {alternateQuery {}} {queryFieldType {first}} {searchInputValue {}}
	{childIdentifier {}} {forceRecentFlag 0} {forceHistoryBackFlag 1}
} {
	global env
	global cgi
	global searchResultList	;# set in CreateOutput
	global numberOfActiveSites
	global currentRep	;# mirror repository
	global numberOfSites	;# set in MultipleSubmit
	global listOfInactiveSites	;# set in CreateOutput
	global loCoInRepList	;# set in MultipleSubmit
	global siteWarning
	global singularSiteWarning
	global singularSiteWarning2
	global pluralSiteWarning
	global pluralSiteWarning2
	global searchWarning
	global errorMessage	;# set in CreateOutput
	global wrongPassword	;# set in CreateOutput
	global administratorUserName	;# set in CreateOutput
	global currentVariableFileName	;# set in enSearchResult.tcl (sourced in CreateOutput)
	global currentProcedureName	;# set in MirrorSearch
#	global currentFileName	;# set in MirrorSearch
	global currentProcedureFileName	;# set in MirrorSearch

if 1 {
# should be set to 0 in the future
	global {full reference}	;# on the verge of extinction since 2010-01-03
	global {cover}	;# on the verge of extinction since 2010-01-03
	global {access}	;# on the verge of extinction since 2010-01-03
	global {access the files that comprise the document}	;# on the verge of extinction since 2010-01-03
	global {download}	;# on the verge of extinction since 2010-01-03
	global {download the files that comprise the document}	;# on the verge of extinction since 2010-01-03
	global {copy}	;# changed to export in 2009-05-14
	global {export}	;# on the verge of extinction since 2010-01-03
	global {download the files that comprise the document and its metadata}	;# on the verge of extinction since 2010-01-03
	global {retrieve}	;# on the verge of extinction since 2010-01-31
	global {update the document and its metadata}	;# on the verge of extinction since 2010-01-31
	global {open the form in another window and let your password be memorized}	;# on the verge of extinction since 2010-01-31
	global {update}	;# on the verge of extinction since 2010-01-31
	global {duplicate the document}	;# on the verge of extinction since 2010-01-31
	global {duplicate}	;# on the verge of extinction since 2010-01-31
	global {review}	;# on the verge of extinction since 2010-01-03
	global {statistics}	;# on the verge of extinction since 2010-01-03
	global {Your work has been published? Select the vehicle type}	;# on the verge of extinction since 2010-01-31 
}

	global {Update}	;# set in mirror/xxSearchResult.tcl
	global {full document}
	global {Empty Fields}
	global {without cover}	;# not used from September 2003
	global {Kbyte}
	global {Kbytes}
	global { looking up in $numberOfActiveSites out of $numberOfSites sites}
	global {The contributor of this data base is listed below.}
	global {The contributor of this data base, extracted from $numberOfActiveSites
out of $numberOfSites sites, is listed below.}
	global {The contributors of this data base are listed below.}
	global {The contributors of this data base, extracted from $numberOfActiveSites
out of $numberOfSites sites, are listed below.}
	global {The most recent reference is listed below.}
	global {The $numberOfReferences most recent references are listed below, the first one being the most recent.}
	global {There is no reference to be displayed for this data base.}
	global {The most recent reference, extracted from $numberOfActiveSites
out of $numberOfSites sites, is listed below.}
	global {The $numberOfReferences most recent references, extracted from $numberOfActiveSites
out of $numberOfSites sites, are listed below, the first one being the most recent.}
	global {Eventually not all the expected references could be displayed because at least one site failed.}
	global siteHelp
	global ${top}Singular
	global ${top}Plural
	global topForContinue
	global bodySystemLimit
	global topFull
	global bodyOutOfDate2
	global {out-of-date reference}
	global {unaccessible reference}	
	global {No}

	global accessDate
	global {Jan}
	global {Feb}
	global {Mar}
	global {Apr}
	global {May}
	global {Jun}
	global {Jul}
	global {Aug}
	global {Sep}
	global {Oct}
	global {Nov}
	global {Dec}

# Migration 2011-01-15
## Migration 2007-01-28
#	global {Posted in UR<I>Lib</I> repository:}
#	global {Posted in:}
## Migration 2007-01-28 - end
# Migration 2011-01-15 - end
	global {copy to clipboard}
	global {Available from:}
	global {Access in:}
##	global {How to Make the Citation of this Document using the INPE Standard - BibINPE Format}
#	global {How to cite this Document using the INPE Standard - BibINPE Format}
#	global {How to cite the Document identified by the URI &lt;}
#	global {&gt; using the INPE standard - BibINPE format)}

	global {See also:}
#	global {Electronic Document Format - BibINPE}
	global {How to Make the In-Text Citation - by author/year}
	global {and}
	global {as proposed by}
	global {may be found in the literature}
	global {missing or empty field: }
	global {incomplete reference}
	global {not an BibINPE reference}
	global {Is a Copy?}	;# used in CreateFullEntry only
	global {yes}	;# used in CreateFullEntry only
	global {no}	;# used in CreateFullEntry only
	global {History}	;# used in CreateFullEntry only
#	global {Document Stage}	;# used in CreateFullEntry only
	global {Content Stage}	;# used in CreateFullEntry only
	global {work-in-progress}	;# used in CreateFullEntry only
	global {completed}	;# used in CreateFullEntry only
	global {transferred to}	;# used in CreateFullEntry only
	global {not transferred}	;# used in CreateFullEntry only
	global {slides}	;# used in CreateFullBibINPEEntry only
	global {Slides}	;# used in CreateFullBibINPEEntry only
	global {Translation by}	;# used in CreateFullBibINPEEntry only
	global {Arrangement}	;# used in CreateFullEntry only
	global {doc Directory Content}	;# used in CreateFullEntry only
	global {source Directory Content}	;# used in CreateFullEntry only
	global {there are no files}
#	global {agreement Directory Link}	;# used in CreateFullEntry only
#	global {directory doesn't exist}	;# used in CreateFullEntry only
	global {agreement Directory Content}	;# used in CreateFullEntry only
	global {see directory content}	;# used in CreateFullEntry only

	global mirrorHomePageRepository	;# set in MirrorSearch
	global mirrorHomePageRep	;# defined in FindLanguage (utilities1.tcl)
	global col	;# used by CreateReturnButton (set in CreateOutput)
	global homePath	;# used when sourcing xxFillingInstructions.tcl
	
# global below are used with safe interpreter
	global translationTable	;# set in mirror/xxSearchResult.tcl

	upvar bgColor bgColor
	upvar background background
	upvar bgProperties bgProperties
	upvar fontTag fontTag
	upvar fontTag2 fontTag2
	upvar display display
	upvar language language
	upvar shortVersionOfLanguage shortVersionOfLanguage
	upvar languageRep1 languageRep1	;# to access .css from topSearchPlural (for example)
	upvar languageRep2 languageRep2
	upvar submissionFormRep submissionFormRep	;# to access submission.js from topForContinue
	upvar returnWarning returnWarning
	upvar output2 output2	;# set in this procedure and used in CreateOutput
	upvar submissionFormLanguageRep submissionFormLanguageRep	;# for sourcing xxFillingInstructions.tcl
	upvar submissionFormLanguage submissionFormLanguage	;# for sourcing xxFillingInstructions.tcl
	upvar relatedFlag relatedFlag	;# set in CreateOutput; used in topForContinue
	
# puts [CallTrace]
# set xxx [CallTrace]
# Store xxx C:/tmp/bbb.txt auto 0 a

	if [regexp {^brief} $type] {
# xxFillingInstructions.tcl is needed to translate the reference type for brief and briefTitleAuthorMisc
		if ![info exists translationTable] {
# not within slave interperter
			source ../$col/$languageRep2/doc/${language}FillingInstructions.tcl
		}
	}

# continue (used by the Return Button - see mirrorget.tcl)
	if $flag {
		set continue no
	} else {
		set continue yes
	}

# changing return button default
	if ![info exists cgi(returnbutton)] {set cgi(returnbutton) no}

	if [regexp {DisplayMultipleSearch|DisplaySearch} [CallTrace]] {
#		set returnButton no	;# used below when doing substitution within the update line created by CreateBriefTitleAuthorEntry 
#		set targetFrame {}	;# used below when doing substitution within the update line created by CreateBriefTitleAuthorEntry 
	} else {
		set returnButton $cgi(returnbutton)
#		if [info exists cgi(targetframe)] {set targetFrame $cgi(targetframe)}	;# commented by GJFB on 2020-06-19 - see below
	}

# puts $cgi(targetframe)

	if ![info exists cgi(languagebutton)] {set cgi(languagebutton) $language}	;# old sites don't define the language button (for example at "The Most Recent" button)

# localSite
	set localSite $env(SERVER_NAME):$env(SERVER_PORT)	;# $env(HTTP_HOST) not used because can be shorter like sputnik:1909
# serverAddress
	set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# serverAddressWithIP
	set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
## pID
#	set pID [pid]
# requestURI
# keywords
	set requestURI {}	;# used in subst [join $entry \n] when entry comes from CreateBriefEntry, CreateBriefTitleAuthorEntry or CreateFullEntry to create the returnaddress (see xxUpdateSubmission.html)
	if {[info exists cgi(query)] && (![info exists cgi(multiplesearch)] || !$cgi(multiplesearch))} {
# simple query (not a list of queries)
# cgi(multiplesearch) is set in GetSearchResult (its value is 1 when GetSearchResult is called by DisplayDuplicates)
		regsub -all {\&} $cgi(query) {%26} query	;# & is an alias for "and" in queries
		regsub -all {#} $query {%23} query	;# needed with queries incluing field names like #issn
		lappend requestURI query=$query
		set keywords [Execute $serverAddressWithIP [list ReturnWordListOfSearchExpression $cgi(query)]]	;# cgi(query) must not be a list, otherwise ReturnWordListOfSearchExpression returns an infinite loop error message
	} else {
		set keywords {}
	}
# puts --$keywords--
	lappend requestURI alternatequery=$alternateQuery

	if [info exists cgi(query2)] {
		regsub -all {\&} $cgi(query2) {%26} query2	;# & is an alias for "and" in queries
		regsub -all {#} $query2 {%23} query2	;# needed with queries incluing field names like #issn
		lappend requestURI query2=$query2
	}
	
	ConditionalSet accent cgi(accent) yes	;# used to highlight words
	ConditionalSet case cgi(case) yes	;# used to highlight words
	
	if [info exists cgi(languagebutton)] {lappend requestURI languagebutton=$cgi(languagebutton)}
#	if [info exists cgi(returnbutton)] {lappend requestURI returnbutton=$cgi(returnbutton)}
	lappend requestURI returnbutton=$returnButton
#	if [info exists cgi(targetframe)] {lappend requestURI targetframe=$cgi(targetframe)}
#	if [info exists targetFrame] {lappend requestURI targetframe=$targetFrame}	;# commented by GJFB on 2020-06-19 - useless
	if [info exists cgi(choice)] {lappend requestURI choice=$cgi(choice)}
	if [info exists cgi(sort)] {lappend requestURI sort=$cgi(sort)}
	if [info exists cgi(accent)] {lappend requestURI accent=$cgi(accent)}
	if [info exists cgi(case)] {lappend requestURI case=$cgi(case)}
	if [info exists cgi(outputformat)] {lappend requestURI outputformat=$cgi(outputformat)}
	if [info exists cgi(linktype)] {lappend requestURI linktype=$cgi(linktype)}
	if [info exists cgi(targetvalue)] {lappend requestURI targetvalue=$cgi(targetvalue)}	;# added by GJFB on 2022-02-13 - used when a local search within an Archival Unit results in more than 10 records
	if [info exists cgi(cssfileurl)] {lappend requestURI cssfileurl=$cgi(cssfileurl)}
	if [info exists cgi(codedpassword1)] {
		set codedPassword $cgi(codedpassword1)
		regsub -all {&} $codedPassword {%26} codedPassword	;# added by GJFB on 2020-01-15 because of coded password with special character like &	
		regsub -all {=} $codedPassword {%3d} codedPassword	;# added by GJFB on 2020-01-15	
		regsub -all {\?} $codedPassword {%3f} codedPassword	;# added by GJFB on 2020-01-15
		lappend requestURI codedpassword1=$codedPassword
	}
	if [info exists cgi(dontdisplaysearchresultwarning)] {lappend requestURI dontdisplaysearchresultwarning=$cgi(dontdisplaysearchresultwarning)}
	if [info exists cgi(nameformat)] {lappend requestURI nameformat=$cgi(nameformat)}
	if [info exists cgi(nameseparator)] {lappend requestURI nameseparator=$cgi(nameseparator)}
	if [info exists cgi(continue)] {lappend requestURI continue=$cgi(continue)}

	set requestURI [join $requestURI &]
	regsub -all -- {\+} $requestURI {%2B} requestURI
	regsub -all { } $requestURI {+} requestURI
	regsub -all {<} $requestURI {%3c} requestURI
	regsub -all {>} $requestURI {%3e} requestURI
	set requestURI2 $requestURI	;# for no substitutions - used by ComputeRelatedLink - needed for search like: ref Journal and y 201[0-2]
#	set requestURI3 $requestURI	;# used by topForContinue to create the correct action (action2) of the "Display All" button - needed for search like: ref Journal and y 201[0-2] with more than 10 references - commented by GJFB on 2020-07-09 - not used anymore after script change from [CreateReturnButton... to \\\[CreateReturnButton and requestURI2 instead of requestURI3 in mirror/xxSearchResult.tcl
	if {[info exists cgi(choice)] && [regexp {^(full|brief)$} $cgi(choice)]} {
if 1 {
# for 3 subst
		regsub -all {\[} $requestURI {\\\\\\\\\\\\\[} requestURI	;# [ -> \\\\\\\[
		regsub -all {\]} $requestURI {\\\\\\\\\\\\\]} requestURI	;# ] -> \\\\\\\]
#		regsub -all {\[} $requestURI3 {\\\\\[} requestURI3	;# [ -> \\\[ - commented by GJFB on 2020-06-14
#		regsub -all {\]} $requestURI3 {\\\\\]} requestURI3	;# ] -> \\\] - commented by GJFB on 2020-06-14
} else {
		regsub -all {\[} $requestURI {%21} requestURI	;# added by GJFB on 2021-06-13 - solve title like T&D
		regsub -all {\]} $requestURI {%23} requestURI	;# added by GJFB on 2021-06-13 - solve title like T&D
}
	} else {
# for 2 subst
		regsub -all {\[} $requestURI {\\\\\[} requestURI	;# [ -> \\\[
		regsub -all {\]} $requestURI {\\\\\]} requestURI	;# ] -> \\\]
	}
if 0 {
# commented by GJFB on 2020-07-09 - not used anymore after script change from [CreateReturnButton... to \\\[CreateReturnButton and requestURI2 instead of requestURI3 in mirror/xxSearchResult.tcl
	if [info exists cgi(choice)] {
		regsub -all {\[} $requestURI3 {\\\\\[} requestURI3	;# [ -> \\\[	;# added by GJFB on 2020-06-14 - required for all choices
		regsub -all {\]} $requestURI3 {\\\\\]} requestURI3	;# ] -> \\\]	;# added by GJFB on 2020-06-14 - required for all choices
	}
}
# puts $top
	if {[string equal {topSearch} $top]} {
		set requestURI /col/$currentRep/doc/mirrorsearch.cgi?$requestURI
		set requestURI2 /col/$currentRep/doc/mirrorsearch.cgi?$requestURI2	;# used by ComputeRelatedLink
#		set requestURI3 /col/$currentRep/doc/mirrorsearch.cgi?$requestURI3	;# used by topForContinue - commented by GJFB on 2020-07-09 - not used anymore after script change from [CreateReturnButton... to \\\[CreateReturnButton and requestURI2 instead of requestURI3 in mirror/xxSearchResult.tcl
	} elseif {[string equal {topRecent} $top]} {
		set requestURI /col/$currentRep/doc/mirror.cgi/Recent?$requestURI
		set requestURI2 /col/$currentRep/doc/mirror.cgi/Recent?$requestURI2	;# used by ComputeRelatedLink
	} elseif {[string equal {topContributors} $top]} {
		set requestURI /col/$currentRep/doc/mirror.cgi/Contributors?$requestURI
	}

# puts $cgi(query)
# puts [array names cgi]
# puts $requestURI

# query2String (useful to restart a search in the case of an out-of-date
# reference)
#	set query2String query2=$cgi(query)&choice2=$cgi(choice)&case2=$cgi(case)
#	set query2String [eval $query2String]
	set query2String [subst $query2String]
# puts $query2String
	regsub -all -- {\+} $query2String {%2B} query2String
	regsub -all { } $query2String {+} query2String
# accessdate
	set accessDate [subst [GetAccessDate $accessDate]]
	set numberOfReferences [llength $searchResultList]
# puts $numberOfReferences
#	set searchResultList [join $searchResultList]
# puts [list $searchResultList <BR>]
# LOOP OVER EACH ENTRY
	set firstEntry 1
# puts --$searchResultList--
	if [string equal {{}} $searchResultList] {
#		puts "<PRE>empty search result</PRE>"
		return	;# added by GJFB on 2010-09-09 (after an update, the similar list may be empty)
	}
	
# set time1 [clock milliseconds]

	set output2 {}
	set i 0
#	set i 2
# FOREACH
# puts [fconfigure stdout]
	foreach searchResult $searchResultList {
# set time$i [clock milliseconds]
# set j [expr $i - 1]
# puts LOOP-[expr [set time$i] - [set time$j]]
if 0 {
# testing progressive loading
	puts 1
	puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
	set x 0; after 1000 {set x 1}; vwait x
}
# EXTRACT siteList citationKey metadataLastUpdate rep-i state sortedFieldValue
		foreach {siteList citationKey metadataLastUpdate rep-i state sortedFieldValue} $searchResult {break}
# sortedFieldValue is not used in LoopOverEntries
		set site [lindex $siteList 0]
# puts $site
# puts [list ${rep-i} $metadataLastUpdate]
#		if [regexp {(.*):(.*)} $site m serverName serverPort]
		set remoteServerAddressWithIP [ReturnCommunicationAddress $site]
		foreach {serverName urlibPort} $remoteServerAddressWithIP {break}
#		if [catch \
		{StartCommunication $serverName $urlibPort} \
		localURLibClientSocketId] {continue}	;# catch is for unix
# entry
# puts [list $site == $serverAddress]
#		if {$site == "$serverAddress"} #
		if [string equal "$serverName $urlibPort" $serverAddress] {
# currentRep is the current mirror repository
			set mirrorRep $currentRep
		} else {
			set mirrorRep {}
		}
		set cellBackgroundColor [lindex $cellBackgroundColors [expr $i%2]]	;# for the latest acquisitions

# timeStamp
		set timeStamp [lindex $env(SERVICE_VERSION) 0]

# the comments below are because includeReturnAddress must not be changed when working with search result page otherwise we don't execute again a search after an update
#			if {[info exists cgi(returnbutton)] && [string compare {no} $cgi(returnbutton)] == 0} {
#				set includeReturnAddress no	;# used with dynamic pages (for example: author index)
#			}

# puts [info exists cgi(languagebutton)]
# puts $citationKey
# => Banon:2020:CaAsSo
# => 1.00 (when searching for related content)
		set similarity $citationKey

# EXTRA
# >>> extra is used in GetEntry only
#		set extra [list $keywords $excludedFields 0 $env(REMOTE_ADDR) $numbering $outputFormat $cellBackgroundColor $timeStamp $pageFlag $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $nameFormat $nameSeparator $accent $case $similarity $originalRepForSimilarity $imageFlag]	;# commented by GJFB on 2022-02-07
		set mirrorGetFlag 0	;# added by GJFB on 2022-02-07
#		set extra [list $keywords $excludedFields 0 $env(REMOTE_ADDR) $numbering $outputFormat $cellBackgroundColor $timeStamp $pageFlag $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $nameFormat $nameSeparator $accent $case $similarity $originalRepForSimilarity $imageFlag $mirrorGetFlag]	;# added by GJFB on 2022-02-07 - commented by GJFB on 2022-06-13
#		set extra [list $keywords $excludedFields 0 $env(REMOTE_ADDR) $numbering $outputFormat $cellBackgroundColor $timeStamp $pageFlag $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $nameFormat $nameSeparator $accent $case $similarity $originalRepForSimilarity $imageFlag $mirrorGetFlag $searchInputValue $childIdentifier $forceRecentFlag]	;# added by GJFB on 2022-06-13
		set extra [list $keywords $excludedFields 0 $env(REMOTE_ADDR) $numbering $outputFormat $cellBackgroundColor $timeStamp $pageFlag $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $nameFormat $nameSeparator $accent $case $similarity $originalRepForSimilarity $imageFlag $mirrorGetFlag $searchInputValue $childIdentifier $forceRecentFlag $forceHistoryBackFlag]	;# added by GJFB on 2023-06-09
# puts [list GetEntry ${rep-i} $mirrorRep $type $path $languageRep2 $extra]
# SUBMIT
#		set entry [Submit $localURLibClientSocketId [list GetEntry ${rep-i} $mirrorRep $type $path $pID $extra]]	;# async
#		close $localURLibClientSocketId
#		if [catch {Execute $site [list GetEntry ${rep-i} $mirrorRep $type $path $pID $extra]} entry] {continue}
# puts [list Execute $site [list GetEntry ${rep-i} $mirrorRep $type $path $languageRep2 $extra]]
# puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
		if [catch {Execute $site [list GetEntry ${rep-i} $mirrorRep $type $path $languageRep2 $extra]} entry] {
# puts $entry			
# puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
#			continue	;# commented by GJFB on 2013-09-15 to allow the display of the "unaccessible reference" message (useful when the command: socket -async mtc-m19.sid.inpe.br 800 returns the error: couldn't open socket: invalid argument)
			set entry {}	;# added by GJFB on 2013-09-15 to allow the display of the "unaccessible reference" message (useful when the command: socket -async mtc-m19.sid.inpe.br 800 returns the error: couldn't open socket: invalid argument)
		}
# >>>1 the line below returns the error message
# puts --$entry--
# set xxx --$entry--
# Store xxx C:/tmp/bbb.txt auto 0 a

		if [regexp {^<(.*)>$} $entry m errorMessage] {
			puts <PRE>[CallTrace]\n[join $errorMessage \n]</PRE>
#			exit
			return
		}

# puts --$entry--
		if [catch {lindex $entry 0} metadataLastUpdate2] {
			puts $entry
			puts <PRE>[CallTrace]</PRE>
#			exit
			return
		}

#		set entry [lindex $entry end]

# Header
# puts $header
		if $header {
			if $firstEntry {
# display the commun search result
# puts $numberOfEntries
				if [info exists cgi(query)] {
					set queryForDisplay [MountQueryForDisplay $cgi(query)]	;# used in subst below
				}
				if {$numberOfEntries == 1} {
#					set output [subst $${top}Singular]
					set output [subst [subst [subst [subst $${top}Singular]]]]
				} else {
					if {$flag && ![regexp Recent $top]} {
# puts [subst $topForContinue]
						set output [subst [subst [subst $topForContinue]]]
#						set output [subst $topForContinue]
#						set output [subst [subst $topForContinue]]
					} else {
# puts [subst [set ${top}Plural]]
						set output [subst [subst [subst [set ${top}Plural]]]]
#						set output [subst [subst [set ${top}Plural]]]
					}
				}
				puts [SetFont $output]
#				puts </TD></TR></TABLE>\n
# exit
				if {[info exists cgi(choice)] && $cgi(choice) == "site"} {
# display the sites having the current repository
					set output $siteHelp
					puts $output
				}
				if {[info exists cgi(choice)] && [regexp {fullXML} $cgi(choice)]} {
#					puts {<FONT FACE="Courier" SIZE=3>}	;# "Courier New" doesn't work with some Netscape
					puts <PRE>
					puts {&lt;?xml version="1.0" encoding="ISO-8859-1"?&gt;}	;# added by GJFB on 2020-06-17
					puts {&lt;metadatalist&gt;}	;# added by GJFB on 2020-06-17
				}
			}
			set firstEntry 0
		}
# Header - end

# puts ${rep-i}<BR>
# puts [list [expr !$header] --$metadataLastUpdate-- --$metadataLastUpdate2--]
		if {(!$header || [string equal $metadataLastUpdate $metadataLastUpdate2]) || \
		[info exists cgi(choice)] && $cgi(choice) == "site"} {
			set entry [lindex $entry end]
			set siteList2 {}
# puts OK
			if {$numberOfSites != 1 && [info exists cgi(choice)] && \
			[regexp {short|brief|site} $cgi(choice)]} {
				foreach site $siteList {
					lappend siteList2 "<!-- site list --->
<BR><FONT FACE=\"Courier New\">&lt\;<A HREF=http://[ReturnHTTPHost $site] TARGET=_blank><FONT COLOR=GRAY>[ReturnHTTPHost $site]</FONT></A>&gt\;</FONT>"
				}
			}
			set siteList2 [join $siteList2]

## the if below is for Juliana's work (to allow the command subst)
#			if ![string equal {brief} $type] #
				regsub -all {\[} $entry {\[} entry	;# [ -> \[
				regsub -all {\]} $entry {\]} entry	;# ] -> \]
#			#
if 1 {
# added by GJFB on 2021-05-28 - useful to control the + button on the right side of the update button in brief
				regsub -all {\\\[\\\[} $entry {[} entry	;# \[\[ -> [
				regsub -all {\\\]\\\]} $entry {]} entry	;# \]\] -> ]
}
# encodingName
			set encodingName [Execute $remoteServerAddressWithIP [list GetEncodingName]]
# puts $encodingName
# puts $entry

#			set entry2 [encoding convertfrom $env(ENCODING_SYSTEM) [SetFont [subst [join $entry \n]]]]	;# uses query2String and siteList2
#			set entry2 [SetFont [join $entry \n]]	;# uses query2String and siteList2
			set entry2 [SetFont [subst [join $entry \n]]]	;# uses query2String and siteList2
			if [string equal {utf-8} $encodingName] {
				set entry2 [encoding convertfrom utf-8 $entry2]	;# solves the accent problem - added by GJFB on 2010-11-16 - needed when displaying search result of plutao (see for example title of J8LNKAN8RW/38JE8FB in plutao (working with utf-8)) from banon-pc3
			}
#			set entry2 [encoding convertfrom iso8859-1 [SetFont [subst [join $entry \n]]]]
# puts $header
			if $header {
# puts $entry
# puts [join $entry \n]
# >>>2 the line below returns the error message
# catch {subst [join $entry \n]} xxx
# catch {join $entry \n} xxx
# puts $xxx
# if {$i == 9} {
#	puts 2
#	exit
# }
# puts $type
				if [regexp {^briefTitleAuthor} $type] {
# briefTitleAuthor and briefTitleAuthorMisc
					puts $entry2
					puts <BR>
#					puts "<!-- [string repeat a 4096] -->"	;# to have the entry displayed at once
					if [info exists cgi(comment)] {puts $cgi(comment)}
				} else {
					if [regexp {^brief$} $type] {
# brief
#						puts "<TABLE><TR><TD width=700 class=displayTD>"
# puts OK
						puts $entry2
# puts OK2
						puts "<!-- [string repeat a 4096] -->"	;# to have the entry displayed at once
#						puts </TD></TR></TABLE>\n
					} elseif {[regexp {^full$} $type]} {
# full
#						puts <TABLE><TR>
						puts $entry2
#						puts </TR></TABLE>\n
					} elseif {[regexp {^fullXML$} $type]} {
# fullXML
						regsub -all {<} $entry2 {\&lt;} entry2	;# < -> &lt; 
						regsub -all {>} $entry2 {\&gt;} entry2	;# > -> &gt; 
						puts $entry2
					} else {
						puts "<TABLE><TR><TD class=displayTD>"
						if {[info exists cgi(choice)] && $cgi(choice) == "fullbibtex"} {puts <PRE>}
						puts $entry2
						if {[info exists cgi(choice)] && $cgi(choice) == "fullbibtex"} {puts </PRE>}
						puts </TD></TR></TABLE>\n
					}
				}
			} else {
				if [regexp {^brief$} $type] {
#					lappend output2 "<TABLE><TR><TD class=displayTD>"
#					lappend output2 "<TABLE><TR><TD width=700 class=displayTD>"
					lappend output2 $entry2
#					lappend output2 </TD></TR></TABLE>\n
				} else {
					lappend output2 $entry2
				}
			}
		} else {
			puts "<TABLE><TR><TD class=displayTD>"
			set citationKey2 [EscapeUntrustedData $citationKey] ;# added by GJFB on 2019-04-30 - the date may contain untrusted data
			if [string equal {} $metadataLastUpdate2] {
# unaccessible reference (request timed out)
				puts "$citationKey2<BR>${unaccessible reference}<BR><FONT FACE=\"Courier New\">&lt;<FONT COLOR=GRAY>[lindex $site 0]</FONT>&gt;</FONT><BR><!-- $site - ${rep-i} --><BR>"
				puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
			} else {
# out-of-date reference
# puts --$metadataLastUpdate--
# puts --$metadataLastUpdate2--
#				puts "<FONT size=-1>$citationKey</FONT><BR>${out-of-date reaalference}<BR><!-- ${rep-i} --><BR>"
#				puts "$citationKey2<BR>${out-of-date reference}<BR><FONT FACE=\"Courier New\">&lt;<FONT COLOR=GRAY>[lindex $site 0]</FONT>&gt;</FONT><BR><!-- $site - ${rep-i} - the metadata must be updated using the URLibService window clicking in Edit and then OK --><BR>"
				puts "$citationKey2<BR>${out-of-date reference}<BR><FONT FACE=\"Courier New\">&lt;<FONT COLOR=GRAY>[lindex $site 0]</FONT>&gt;</FONT><BR><!-- $site - ${rep-i} - $metadataLastUpdate2 --><BR>"
			}
			puts </TD></TR></TABLE>\n
		}
# puts OK
#
		incr i
#		if {[info exists cgi(choice)] && [regexp {^full$} $cgi(choice)]} {
#			puts <BR>	;# doesn't work properly with tcl pages (in this case, should be included in output2)
#		}
	}	;# end of foreach
	
# set time3 [clock milliseconds]
# puts LOOP-[expr $time3 -$time2]

}

# LoopOverEntries - end
# ----------------------------------------------------------------------
# CreateOutput
# Create output for MirrorSearch, CreateMirror, DisplaySearch and DisplayNumberOfEntries
# (Contributors and The Most Recent)
# if cgi(continue) exists when CreateOutput is called then
# the maximumNumberOfEntries is ignored
# Some argument examples:
# $query == list GetMetadataRepositories $mirrorRep 3 $cgi(query) $cgi(accent) $cgi(case) 1 metadatalastupdate
# $query2String == query2=$cgi(query)&choice2=$cgi(choice)&accent2=$cgi(accent)&case2=$cgi(case)
# some option values are:
# Recent, Contributors, Search ...
# header value is 0 or 1
# 0 means drop the header (and footer - <HTML> ... </HTML>) used with XML, GetSearchResult, ...
# entryEvaluationFunctions value is 0 or 1 or a list of two unary operations (functions) and one binary operation
# 0 means to ignore entry evaluation
# 1 means just to return the number of entries (used by DisplayNumberOfEntries)
# localSearch value is 0 or 1; 1 means to run just a local search (used to create local index - see StartService)
# numbering value is {} or {numbering prefix}; {} means to do no numbering
# outputFormat value is boolean or {html code} or a list of field names; used by briefTitleAuthorMisc and CreateDateTitleSite - default is used by briefTitleAuthorMisc
# cellBackgroundColors value is a list of two colors; for example: {#EEEEEE #E3E3E3}; used by CreateDateTitleSite
# page value is no or yes; used by CreateBriefTitleAuthorEntry
# includeReturnAddress value is yes or no; set in GetSearchResult and used in CreateBriefEntry (see update link)
# linkType used by CreateBriefTitleAuthorEntry (see CreateBriefTitleAuthorEntry)
# passwordError value is 0 or 1; 1 means that a warning message must be displayed (set by the Form option)
# targetValue is for example _blank, _self, ...
# dateFieldName is metadatalastupdate or issuedate (used by CreateDateTitleSite)
# siteFieldName is site or newspaper (used by CreateDateTitleSite)
# returnButton value is no or yes
# nameFormat value is short, familynamefirst or familynamelast (used by CreateBriefTitleAuthorEntry)
# nameSeparator value is a string like {; } or {<BR>} (used by CreateBriefTitleAuthorEntry)
# searchInputValue is a search expression - set in URL (used in mirrorHomePage.html, CreateMirror, LoopOverEntries, GetEntry and CreateBriefEntry)
# childIdentifier (ex: mirrorIdentifier) is an IBIp or IBIn - set in MirrorSearch and used in CreateBriefEntry
# forceRecentFlag value is 0 (default) or 1 - 1 set in MirrorRecent is used to return to 'The most Recent' after clicking in Return (<) in the horizontal upper menu (see Get)
# forceHistoryBackFlag value is 0 or 1 (default) - 0 set in CreateMirror and 1 set in Get, both are used in mirror/xxCover.tcl

proc CreateOutput {
	language languageRep1 languageRep2 query query2String option path
	{entryEvaluationFunctions 0} {maximumNumberOfEntries 10} {type brief} {header 1}
	{excludedFields {^$}} {localSearch 0} {numbering {}} {outputFormat 1}
	{cellBackgroundColors {#EEEEEE #E3E3E3}} {siteList {}} {page no}
	{includeReturnAddress yes} {linkType 0} {passwordError 0}
	{targetValue _blank} {dateFieldName metadatalastupdate}
	{siteFieldName site} {returnButton no} {cssFileURL {}}
	{nameFormat {short}} {nameSeparator {; }} {searchInputValue {}} {childIdentifier {}}
	{forceRecentFlag 0} {forceHistoryBackFlag 1}
} {
	global searchResultList	;# set in this procedure
	global env
	global currentRep	;# mirror repository - used in subst, GetFrameName and MultipleSubmit - set by DisplaySearch for example
	global cgi
	global numberOfSites	;# set in MultipleSubmit
	global listOfSites	;# set in MultipleSubmit
	global numberOfSatisfiedQueries	;# set in this procedure and used in DisplayNumber
	global numberOfActiveSites	;# set in this procedure
#	global listOfActiveSites	;# set in MultipleSubmit
	global listOfInactiveSites	;# set in this procedure
	global siteWarning
	global singularSiteWarning
	global singularSiteWarning2
	global pluralSiteWarning
	global pluralSiteWarning2
	global searchWarning
	global errorMessage	;# used in LoopOverEntries
	global wrongPassword	;# used in LoopOverEntries
	global administratorUserName	;# used in LoopOverEntries
	global mirrorHomePageRepository	;# set in MirrorSearch
	global mirrorHomePageRep	;# defined in FindLanguage (utilities1.tcl)
	global numberOfEntries	;# used by DisplaySearch
	global col	;# used by CreateReturnButton (through LoopOverEntries)
	global homePath	;# used in enSearchResult.tcl, ...
	global currentVariableFileName	;# used in LoopOverEntries
	global currentProcedureName	;# set in MirrorSearch - needed when no references are found
#	global currentFileName	;# set in MirrorSearch - needed when no references are found 
	global currentProcedureFileName	;# set in MirrorSearch - needed when no references are found
	global {full reference}	;# set in source xxSearchResult.tcl
	global {<FONT COLOR=BROWN>Password error. - Hidden entries not shown.</FONT><BR>}	;# set in source xxSearchResult.tcl
	global {Eventually not all the expected references could be displayed because at least one site failed.}

# global below are used with safe interpreter
	global bgColor background bgProperties fontTag fontTag2
	global bodyForError
	global log
	
	global Return
	global Copy
	global topSearchSingular
	global topSearchPlural
	global No
	global { looking up in $numberOfActiveSites out of $numberOfSites sites}

#	upvar environment environment	;# used in MultipleSubmit
	upvar submissionFormRep submissionFormRep	;# to access submission.js from topForContinue
	upvar submissionFormLanguageRep submissionFormLanguageRep	;# used in LoopOverEntries for sourcing xxFillingInstructions.tcl
	upvar submissionFormLanguage submissionFormLanguage	;# used in LoopOverEntries for sourcing xxFillingInstructions.tcl

if 0 {
# testing progressive loading
	puts 1
	puts "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
	set x 0; after 1000 {set x 1}; vwait x
}
# puts [array get cgi]
# puts [CallTrace]
# extra code for copying to clipboard
	if {[info exists cgi(choice)] && [string equal {brief} $cgi(choice)]} {
# puts $env(PATH_INFO)
#		set pathDepth [llength [file split $env(PATH_INFO)]]	;# commented by GJFB on 2019-12-06 - the command name 'file' is invalid under safe interpreter
#		set returnPath [eval file join [split [string trim [string repeat {.. } $pathDepth]]]]	;# commented by GJFB on 2019-12-06 - the command name 'file' is invalid under safe interpreter
		regsub -all {[^/]+} xx$env(PATH_INFO) {..} returnPath	;# added by GJFB on 2019-12-06
# puts $returnPath
# added by GJFB on 2019-10-13 for copying to clipboard
		set extraCode2 "
			<script language=\"JavaScript\" src=\"$returnPath/dpi.inpe.br/banon/2000/01.23.20.24/doc/clipboard.min.js\"></script>
			<script language=\"JavaScript\">var clipboard = new ClipboardJS('.copy-letter-button');</script>
		"
	} else {
		set extraCode2 {}	;# added by GJFB on 2019-10-13 for copying to clipboard
	}		
	
# shortVersionOfLanguage
# used in subst in LoopOverEntries
	set shortVersionOfLanguage [string range $language 0 1]	;# pt-BR -> pt - used for the sherpa link only - added by GJFB on 2011-12-07
	
# puts [array get cgi]
	set top top$option	;# topRecent, topSearch, ...

# localSite
	if [info exists env(SERVER_NAME)] {
		set localSite $env(SERVER_NAME):$env(SERVER_PORT)
	} else {
# running with post
# added by GJFB on 2015-08-22
# example: see "testing remote execution of DisplayNumberOfEntries" in cgi/test2
# not in use
		global serverAddress
		set localSite [ReturnHTTPHost $serverAddress]
	}
#	if {[string compare {} $cssFileURL] == 0} {set cssFileURL ../../../../../$languageRep1/doc/mirrorStandard.css}
# puts {Content-Type: text/html}	;# needed when running a tcl page with safeflag == 0
# puts {}	;# needed when running a tcl page with safeflag == 0
# puts --$cssFileURL--
	if [string equal {} $cssFileURL] {set cssFileURL http://$localSite/col/$languageRep1/doc/mirrorStandard.css}	;# default
# puts $cssFileURL
# puts [CallTrace]
# puts $numbering
# puts $currentRep
# puts $query
# puts <BR>
# puts $query2String
# puts [array get cgi]
# puts $includeReturnAddress
# puts $option

	set col ../../../../..

	if ![info exists {full reference}] {
# not within the slave interperter
#		source ../$col/$languageRep2/doc/mirror/${language}SearchResult.tcl
		source $homePath/col/$languageRep2/doc/mirror/${language}SearchResult.tcl
	}

if 0 {
	if ![info exists bgColor] {
# not within the slave interperter
# bgColor, background and bgProperties
		foreach {bgColor background bgProperties fontTag fontTag2} [GetBg $languageRep1 $language] {break}
	}
	set background [subst $background]
}
# display
#	set display [subst [GetFrameName $mirrorHomePageRep]]
	set display [GetFrameName]	;# used after one subsitution in CreateBriefEntry and CreateFullEntry

# Compute siteList
	if {$type == "site"} {
# the search is made over the local site and the sites
# defined in the col/$env(LOCOINREP)/doc/@siteList.txt file
		set siteList [ComputeSiteList $env(LOCOINREP)]	;# see utilities1.tcl
	} elseif $localSearch {
#		set siteList $env(IP_ADDR):$env(SERVER_PORT)
#		set siteList [list [list $env(SERVER_NAME) $env(URLIB_PORT)]]
		set siteList [list [list $env(IP_ADDR) $env(URLIB_PORT)]]
	}
# Compute siteList - end

if ![info exists cgi(codedpassword1)] {set cgi(codedpassword1) {}}	;# added in 2010-07-08; needed for searching related entries of hidden entries

# MULTIPLE SUBMIT
# Store query C:/tmp/bbb.txt binary 0 a
# puts $query
# => list GetMetadataRepositories dpi.inpe.br/banon/1999/06.19.17.00 3 {ti carta} no no 0 metadatalastupdate repArray {} {} 11 {}
# => list GetMetadataRepositories {} 4 {firstgr OBT and {metadatarepository, urlib.net/www/2012/08.10.20.21.38}} no no 1 metadatalastupdate repArray {} key 0 {} 0

# puts --$siteList--
# set time1 [clock milliseconds]

if 0 {
# doesn't work properly with tcl page because of possible multiple calls of CreateOutput
# (for example, through multiple calls of DisplayNumberOfEntries)
	set searchResultList {}
	MultipleSubmit {} $query searchResultList 0 $siteList	;# level == 1
} else {
# puts [list MultipleExecute $siteList $query 0 2]
# set xxx [list MultipleExecute $siteList $query 0 2]
# Store xxx  C:/tmp/bbb.txt auto 0 a
	set scenario 0
	set encodingName iso8859-1	;# used to send queries
#	set searchResultList [MultipleExecute $siteList $query $scenario 2 $encodingName]	;# level 2 is for MultipleSubmit be able to reach currentRep
	foreach {searchResultList numberOfSatisfiedQueries listOfActiveSites} [MultipleExecute2 $siteList $query $scenario 2 $encodingName] {break}	;# level 2 is for MultipleSubmit be able to reach currentRep
}
# set time2 [clock milliseconds]
# puts [expr $time2 -$time1]

# puts [list MultipleExecute $siteList $query 0 2]
# puts <BR>
# puts --$searchResultList--
# => {{vaio 19050} Pereira:2017:Of11Ma {2018:02.26.02.29.39 dpi.inpe.br/banon/1999/01.09.22.14 banon {D 2017}} urlib.net/www/2017/05.11.17.06.17-0 1 2} {{vaio 19050} Pereira:2017:Of8Ma {2018:02.26.02.28.55 dpi.inpe.br/banon/1999/01.09.22.14 banon {D 2017}} urlib.net/www/2017/05.07.20.29.25-0 1}--
# puts [llength $searchResultList]
# set lll [llength $searchResultList]
# Store lll C:/tmp/bbb.txt auto 0 a 
# Store searchResultList C:/tmp/bbb.txt auto 0 a

# errorMessage
	if $passwordError {
		set errorMessage ${<FONT COLOR=BROWN>Password error. - Hidden entries not shown.</FONT><BR>} 
		set wrongPassword yes
	} else {
		set errorMessage {}
		set wrongPassword no
	}
# administrator name
#	regsub {@.*$} $env(SERVER_ADMIN) {} administratorUserName
	set administratorUserName administrator

#	set numberOfActiveSites $numberOfSatisfiedQueries
	set numberOfActiveSites [llength $listOfActiveSites]
	set listOfInactiveSites {}
# puts $listOfSites
# puts $listOfActiveSites
# Store listOfSites C:/tmp/bbb.txt auto 0 a 
# Store listOfActiveSites C:/tmp/bbb.txt auto 0 a 

# listOfInactiveSites
	foreach site $listOfSites {
		foreach {serverName urlibPort} [ReturnCommunicationAddress $site] {break}
		if {[lsearch $listOfActiveSites "$serverName $urlibPort"] == -1} {
			lappend listOfInactiveSites "$serverName $urlibPort"
		}
	}
	
	if {$numberOfSites == 1} {
#		set siteWarning "."	;# no translation needed
		set siteWarning ""	;# no translation needed
		set singularSiteWarning "\${The contributor of this data base is listed below.}"
		set pluralSiteWarning "\${The contributors of this data base are listed below.}"
		set singularSiteWarning2 "\${The most recent reference is listed below.}"
		set pluralSiteWarning2 "\${The \$numberOfReferences most recent references are listed below, the first one being the most recent.}"
	} else {
		set siteWarning "\${ looking up in \$numberOfActiveSites out of \$numberOfSites sites}"
		set singularSiteWarning "\${The contributor of this data base, extracted from \$numberOfActiveSites
out of \$numberOfSites sites, is listed below.}"
		set pluralSiteWarning "\${The contributors of this data base, extracted from \$numberOfActiveSites
out of \$numberOfSites sites, are listed below.}"
		set singularSiteWarning2 "\${The most recent reference, extracted from \$numberOfActiveSites
out of \$numberOfSites sites, is listed below.}"
		set pluralSiteWarning2 "\${The \$numberOfReferences most recent references, extracted from \$numberOfActiveSites
out of \$numberOfSites sites, are listed below, the first one being the most recent.}"
	}
	set searchWarning "\${Eventually not all the expected references could be displayed because at least one site failed.}"

	if [regexp "^\{<(.*)>\}$" $searchResultList m errorMessage] {
# the search expression has a syntax error
		if $header {
			if [info exists cgi(query)] {
				set output [subst [set bodyForError]]
				puts [SetFont $output]
			} else {
# Recent
				puts [join $searchResultList]
			}
			return
		} else {
#			error [join $errorMessage \n]	;# doesn't work with some errorMessage
			error $errorMessage
		}
	} else {
		if ![info exists cgi(continue)] {set cgi(continue) no}
# set xxx $cgi(continue)
# Store xxx C:/tmp/bbb.txt auto 0 a 
# Store query C:/tmp/bbb.txt auto 0 a 

# Find numberOfEntries2
# used when CreateOutput is called from MirrorSearch
# part of the fast mirror search code
# puts $query
		if {[string equal {no} $cgi(continue)] && \
		[string equal {GetMetadataRepositories} [lindex $query 1]] && \
		[lindex $query 3] == 3} {
# query == list GetMetadataRepositories mirrorRep 3
			set numberOfEntries2 0
			foreach searchResult $searchResultList {
# puts $searchResult
				set n 0
				catch {foreach {1 2 3 4 5 n} $searchResult {break}}	;# searchResult may contain a list element in quotes followed by ":" instead of space (for example, when a computer issues an I/O error or a read-only file system)
				if ![string equal {} $n] {
					if [regexp {^\d+$} $n] {
# n is integer
						incr numberOfEntries2 $n
					} else {
# n is not integer
						if [string equal 1 $entryEvaluationFunctions] {	;# added by GJFB on 2017-07-12 - DisplayNumberOfEntries or DisplayCorrelationCoefficient in use
# unexpected searchResult value (for example in the case of the cross communication problem)
							lappend log "CreateOutput: unexpected searchResult value: $searchResult\nthe query was: <$query>."
							return {} 	;# added by GJFB on 2017-07-12 - return empty - used in DisplayNumber

						} else {
							error "CreateOutput: unexpected searchResult value: $searchResult\nthe query was: <$query>."	;# commented by GJFB on 2017-01-01 for testing
#							global replyName	;# added by GJFB on 2017-01-01 for testing - set in MultipleExecute
#							global $replyName	;# added by GJFB on 2017-01-01 for testing - set in MultipleExecute
#							set reply [set $replyName]	;# added by GJFB on 2017-01-01 for testing
#							unset $replyName	;# added by GJFB on 2017-01-01 for testing - previously in MultipleExecute
#							global replyTrace	;# added by GJFB on 2017-01-01 for testing - set in ConcatReplies
							error "CreateOutput: unexpected searchResult value: $searchResult\nthe query was: $query\nthe replyName was: $replyName\nits value was: $reply\nthe replyTrace was: $replyTrace"	;# added by GJFB on 2017-01-01
						}
					}
				}
# lappend log "CreateOutput: the searchResult value is: $searchResult\nthe query was: <$query>."	;# for testing log
			}
# lappend log "xxx\n\n"	;# for testing log
		}
# Find numberOfEntries2 - end

		if ![info exists cgi(fusion)] {set cgi(fusion) yes}
# set xxx $cgi(fusion)
# Store xxx C:/tmp/bbb.txt auto 0 a 
		set returnWarning {}	;# capture the beginning of an error message returned by a site with problem
		if [string equal yes $cgi(fusion)] {
# Make fusion of repeated entries
# puts $searchResultList	;# >>> may return an error message
# Store searchResultList C:/tmp/bbb.txt auto 0 a 
			set searchResultList2 [lsort -command CompareStampRep-iState $searchResultList]	;# puts the original first (if any) when the stamps are the same
			set numberOfEntries [llength $searchResultList2]
# puts $numberOfEntries
# Store numberOfEntries C:/tmp/bbb.txt auto 0 a 
			set searchResultList {}
			for {set i 0} {$i < $numberOfEntries} {} {
				set searchResulti [lindex $searchResultList2 $i]	;# points to the original (if any) - otherwise to the faster site
				if [catch {list [lindex $searchResulti 0]} siteList] {
# searchResulti has a wrong syntax (it probably contains an error message)
					regexp "^<(.*)>$" $searchResulti m returnWarning
#					set returnWarning "[lindex $returnWarning 0] $i"	;# keep just the first element of the error message
					set returnWarning "[lrange $returnWarning 0 1]"	;# keep just the first two elements of the error message - the first element now contains the server address - added by GJFB on 2013-01-06 (see ServeLocalCollection)
					incr i
					continue
				}
				set j [expr $i + 1]
# in order to exit from the while below, it is assumed that searchResulti is never empty
# and is a list with at least four elements (see CompareStampRep-i)
# this is obtained through if {$reply != ""} within GetReply
				while {[CompareStampRep-i $searchResulti [lindex $searchResultList2 $j]] == 0} {
					set searchResultj [lindex $searchResultList2 $j]
					lappend siteList [lindex $searchResultj 0]
					incr j
				}
				set searchResult [lreplace $searchResulti 0 0 $siteList] 
				lappend searchResultList $searchResult
				set i $j
			}
# puts --$searchResultList--
# Store searchResultList C:/tmp/bbb.txt auto 0 a 
# puts $returnWarning
# Make fusion of repeated entries - end
		} else {
# Turn the site element a list element
			set searchResultList2 $searchResultList
			set searchResultList {}
			foreach searchResult $searchResultList2 {
#			set siteList [list [lindex $searchResult 0]]
				if [catch {list [lindex $searchResult 0]} siteList] {
# searchResult has a wrong syntax (it probably contains an error message)
					regexp "^<(.*)>$" $searchResult m returnWarning
					set returnWarning [lindex $returnWarning 0]	;# keep just the first element of the error message
					continue
				}
				set searchResult2 [lreplace $searchResult 0 0 $siteList] 
				lappend searchResultList $searchResult2
			}
# Turn the site element a list element - end
		}

# Store searchResultList C:/tmp/bbb.txt auto 0 a
# => {{{banon-pc3 800}} Nelson:2001:FoFlAm {2009:07.08.21.47.25 dpi.inpe.br/banon/1999/01.09.22.14 banon} dpi.inpe.br/banon/2001/03.25.16.16-5 0} {{{banon-pc3 800}} DaineseNoliAdam:2002:AnTrIn {2009:07.08.21.47.25 dpi.inpe.br/banon/1999/01.09.22.14 banon} dpi.inpe.br/banon/2001/03.25.16.16-16 0} {{{banon-pc3 800}} VenturaFons:2002:ReSeIm {2009:07.08.21.47.25 dpi.inpe.br/banon/1999/01.09.22.14 banon} dpi.inpe.br/banon/2001/03.25.16.16-10 0 7}
# LLENGTH
		set numberOfEntries [llength $searchResultList]
# puts $numberOfEntries
# Store numberOfEntries C:/tmp/bbb.txt auto 0 a 
# => 3

		if {[info exists numberOfEntries2] && $numberOfEntries > $maximumNumberOfEntries}  {
# query == list GetMetadataRepositories mirrorRep 3
# part of the fast mirror search code
			set numberOfEntries $numberOfEntries2
# puts $numberOfEntries
		}
# Store numberOfEntries C:/tmp/bbb.txt auto 0 a
# => 7

# Store entryEvaluationFunctions C:/tmp/bbb.txt auto 0 a
# Return number of entries
		if [string equal 1 $entryEvaluationFunctions] {return $numberOfEntries}
# Return number of entries - end

		if ![string equal 0 $entryEvaluationFunctions] {
# entryEvaluationFunctions is a list of two unary operations (functions) and one binary operation
# example of use: id NENDTJMTKW/37RKTD2
# set function1 {x {return [QualisFunction $x]}}
# set function2 {x {return [ConstantFunction $x]}}
# set operation {{x y} {return [format %4.1f [expr $x / $y.]]}}

			set function1 [lindex $entryEvaluationFunctions 0]
			set function2 [lindex $entryEvaluationFunctions 1]
			set operation [lindex $entryEvaluationFunctions 2]
			set sum1 0
			set sum2 0
if 1 {
			foreach item $searchResultList {
				set sum1 [expr $sum1 + [apply $function1 $item]]
				set sum2 [expr $sum2 + [apply $function2 $item]]
			}
			return [apply $operation $sum1 $sum2]
} else {
# testing
			set item [lindex $searchResultList 0]
			set item2 [lindex $item 3]
			return [apply $function1 $item2]
}
		}

# puts --$searchResultList--
# =>
# {{{gjfb 19050}} :1989:ExClSu {2021:01.27.23.05.20 dpi.inpe.br/banon/1999/01.09.22.14 administrator {D 1989}} urlib.net/www/2020/08.21.23.11.41-0 1 7}
# {{{gjfb 19050}} :1989:ExClSu {2020:08.25.03.19.37 dpi.inpe.br/banon/1999/01.09.22.14 banon {D 1989}} dpi.inpe.br/banon-pc2@80/2008/04.17.15.17.55-0 1}
# ... (plus 5 lines)

# puts [list $numberOfEntries $maximumNumberOfEntries $cgi(continue) $option]

		if ![info exists cgi(username)] {set cgi(username) {}}
		if ![info exists cgi(session)] {set cgi(session) {}}
		if ![info exists cgi(outputformat)] {set cgi(outputformat) {}}	;# added in 2010-10-06; needed by ComputeRelatedLink only
	
		ConditionalSet hideSimilarButton cgi(hidesimilarbutton) {no}
		ConditionalSet imageFlag cgi(imageflag) {1}	;# used to control the thumbnail display in CreateFullEntry
		ConditionalSet alternateQuery cgi(alternatequery) {}	;# used to display the second search (the green one) for continue
		ConditionalSet queryFieldType cgi(queryfieldtype) {}	;# used to display the second search (the green one) for continue

# relatedFlag - used in LoopOverEntries - added by GJFB on 2010-11-02
		set entrySearch [lindex $query 4]
		set relatedFlag [regexp {^related:(.*?):(.*?):(.*?):(.*?):(.*?):(.*?):} $entrySearch m metadataRep-i]
	
		set originalRepForSimilarity {}
		if {[info exists cgi(choice)] && $cgi(choice) != "fullXML" && [regexp no $cgi(continue)] && \
		$numberOfEntries > $maximumNumberOfEntries || \
		[string equal Recent $option]} {
# display a limited number of references
# puts [array get cgi]
# set xxx [array get cgi]
# set xxx $option
# Store xxx C:/Users/gerald.banon/tmp/bbb auto 0 a
			if {[info exists cgi(sort)] && $cgi(sort) == "dateplus"} {
# by date, most recent first
				set searchResultList [lsort -command CompareDate+ $searchResultList]
			} elseif {[info exists cgi(sort)] && [regexp {^page} $cgi(sort)]} {
# by pages (page is accepted) - used by DisplaySearch to display summary
				set searchResultList [lsort -index 5 -integer $searchResultList]
			} elseif {[info exists cgi(sort)] && [regexp {^title$} $cgi(sort)]} {
# by title
				set searchResultList [lsort -index 5 $searchResultList]
			} elseif {[info exists cgi(sort)] && [regexp {^issuedate$} $cgi(sort)]} {
# by issuedate
				set searchResultList [lsort -index 5 -decreasing $searchResultList]
			} elseif {[info exists cgi(sort)] && [string equal {lastupdate} $cgi(sort)]} {
# by lastupdate
# used by xxAbout.html when calling ReturnTheMostRecentEntries CreateOutput LoopOverEntries GetEntry CreateDateTitleSite
				set searchResultList [lsort -command CompareLastUpdateStamp $searchResultList]
			} else {
				set entrySearch [lindex $query 4]
#				if [regexp {^related:(.*?):(.*?):(.*?):(.*?):(.*?):(.*?):} $entrySearch m metadataRep-i] #
				if $relatedFlag {
# by similarity
					set originalRepForSimilarity ${metadataRep-i}	;# used by LoopOverEntries
					set searchResultList [lsort -real -decreasing -index 1 $searchResultList]	;# added by GJFB on 2010-11-02
				} else {
# by stamp (metadatalastupdate)
					set searchResultList [lsort -command CompareStamp $searchResultList]
				}
			}
			set searchResultList [lrange $searchResultList 0 [expr $maximumNumberOfEntries - 1]]
# puts --$searchResultList--
#			LoopOverEntries $query2String $type $numberOfEntries $top $path $header $excludedFields 1 $numbering $outputFormat $cellBackgroundColors $page $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $returnButton $cssFileURL $nameFormat $nameSeparator $originalRepForSimilarity $imageFlag $alternateQuery $queryFieldType	;# commented by GJFB on 2022-06-13
#			LoopOverEntries $query2String $type $numberOfEntries $top $path $header $excludedFields 1 $numbering $outputFormat $cellBackgroundColors $page $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $returnButton $cssFileURL $nameFormat $nameSeparator $originalRepForSimilarity $imageFlag $alternateQuery $queryFieldType $searchInputValue $childIdentifier $forceRecentFlag	;# added by GJFB on 2022-06-13
			LoopOverEntries $query2String $type $numberOfEntries $top $path $header $excludedFields 1 $numbering $outputFormat $cellBackgroundColors $page $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $returnButton $cssFileURL $nameFormat $nameSeparator $originalRepForSimilarity $imageFlag $alternateQuery $queryFieldType $searchInputValue $childIdentifier $forceRecentFlag $forceHistoryBackFlag	;# added by GJFB on 2023-06-09
# set time3 [clock milliseconds]
# puts [expr $time3 -$time2]

			if $header {
#				puts "<TABLE WIDTH=100%><TR><TD class=displayTD>"
				puts [CreateReturnButton <HR> $path$col/$languageRep2/doc/mirror {} $display $Return {} {} {} {} 1]
				puts $extraCode2
				puts <BR></BODY></HTML>
				return
			} else {
# not used any more - now fullXML has hearder
				if {[info exists cgi(choice)] && [regexp {fullXML} $cgi(choice)]} {
					lappend output2 </PRE>
					lappend output2 </FONT>
				}
				return $output2
			}
		} else {
# display all the references
# puts [array get cgi]
			if {[info exists cgi(choice)] && $cgi(choice) == "site"} {
# by stamp
				set searchResultList [lsort -command CompareStamp $searchResultList]
			} elseif {[info exists cgi(choice)] && $cgi(choice) == "dateTitleSite"} {
# by stamp
				set searchResultList [lsort -command CompareStamp $searchResultList]
			} elseif {[info exists cgi(sort)] && $cgi(sort) == "dateplus"} {
# by date, most recent first
				set searchResultList [lsort -command CompareDate+ $searchResultList]
			} elseif {[info exists cgi(sort)] && $cgi(sort) == "dateminus"} {
# by date, oldest first
				set searchResultList [lsort -command CompareDate- $searchResultList]
			} elseif {[info exists cgi(sort)] && [regexp {^page} $cgi(sort)]} {
# by pages (page is accepted) - used by DisplaySearch to display summary
				set searchResultList [lsort -index 5 -integer $searchResultList]
			} elseif {[info exists cgi(sort)] && [regexp {^(number|accessionnumber)$} $cgi(sort)]} {
# by number or accessionnumber (the latter being used with Image)
				set searchResultList [lsort -index 5 -dictionary $searchResultList]
			} elseif {[info exists cgi(sort)] && [regexp {^title$} $cgi(sort)]} {
# by title
				set searchResultList [lsort -index 5 $searchResultList]
#			# elseif {[info exists cgi(sort)] && [regexp {^issuedate$} $cgi(sort)]} #
# by issuedate
			} elseif {[info exists cgi(sort)] && [regexp {date$} $cgi(sort)]} {
# by date, issuedate...
#				set searchResultList [lsort -index 5 -decreasing $searchResultList]	;# commented by GJFB on 2016-03-14
				set searchResultList [lsort -index 5 $searchResultList]	;# added by GJFB on 2016-03-14 - better for id J8LNKB5R7W/3CM2S4E
#			} elseif {[info exists cgi(sort)] && $cgi(sort) == "title"} {
## by title - used by DisplaySearch
#				set searchResultList [lsort -index 6 $searchResultList]
			} else {
				set entrySearch [lindex $query 4]
#				if [regexp {^related:(.*?):(.*?):(.*?):(.*?):(.*?):(.*?):} $entrySearch m metadataRep-i language2 selectedFieldNameList numberOfCombinations importantWordList wordList] #
#				if [regexp {^related:(.*?):(.*?):(.*?):(.*?):(.*?):(.*?):} $entrySearch m metadataRep-i] #
				if $relatedFlag {
# by similarity
# puts ${metadataRep-i}
# puts --$searchResultList--<BR>
					set originalRepForSimilarity ${metadataRep-i}	;# used by LoopOverEntries
					set searchResultList [lsort -real -decreasing -index 1 $searchResultList]
# puts $searchResultList<BR>
# Put the original record at the beginning
					if {[info tclversion] > 8.4} {
# lsearch -index was introduced after 8.4  (used in ComputeSimilarity)
						set index [lsearch -index 3 $searchResultList ${metadataRep-i}]
					} else {
						for {set index 0} {$index <= [llength $searchResultList]} {incr index} {
							if [string equal ${metadataRep-i} [lindex [lindex $searchResultList $index] 3]] {break}
						}
					}
					set firstRecord [list [lindex $searchResultList $index]]
					set searchResultList [lreplace $searchResultList $index $index]
					set searchResultList [concat $firstRecord $searchResultList]
# Put the original record at the beginning - end
				} else {
					if {[info exists cgi(sort)] && [regexp {^date.year.key$} $cgi(sort)]} {
# added by GJFB on 2016-03-14	
## by date.key - used in MountHTMLPage only
#						set searchResultList [lsort -command CompareDateKey $searchResultList]	;# added by GJFB on 2013-10-15 - used by UpdateBody in displaydoccontent.tcl to have the entries sorted by date (and key if the dates are the same) - commented by GJFB on 2018-02-26
# by date.year.key - used in MountHTMLPage only
						set searchResultList [lsort -command CompareDateYearKey $searchResultList]	;# added by GJFB on 2013-10-15 - used by UpdateBody in displaydoccontent.tcl to have the entries sorted by date (and year if the dates are the same (and key if the years are the same)) - sdded by GJFB on 2018-02-26
					} elseif {[info exists cgi(sort)] && [regexp {^year.key.title$} $cgi(sort)]} {
# by year.key.title (default) - used in MountHTMLPage only
# needed because the key contains only a small part of the title
						set searchResultList [lsort -command CompareYearKeyTitle $searchResultList]	;# added by GJFB on 2013-10-15 - used by UpdateBody in displaydoccontent.tcl to have the entries sorted by year (and key if the years are the same (and title if the keys are the same))
					} elseif {[info exists cgi(sort)] && [regexp {^key.title$} $cgi(sort)]} {
# by key.title - was used in MountHTMLPage
# needed because the key contains only a small part of the title
						set searchResultList [lsort -command CompareKeyTitle $searchResultList]	;# added by GJFB on 2013-10-15 - used by UpdateBody in displaydoccontent.tcl to have the entries sorted by key (and title if the keys are the same)
					} elseif {[info exists cgi(sort)] && [regexp {^shorttitle$} $cgi(sort)]} {
# added by GJFB on 2021-02-05	
						set searchResultList [lsort -command CompareSortedField $searchResultList]	;# added by GJFB on 2021-02-05 - used by UpdateBody in displaydoccontent.tcl to have the entries sorted by shorttitle
					} else {
# by key
# puts --$searchResultList--<BR>
#						set searchResultList [lsort -command CompareKey $searchResultList]
						set searchResultList [lsort -dictionary -index 1 $searchResultList]	;# -dictionary added by GJFB on 2011-04-06
					}
				}
			}
# puts $searchResultList<BR>
# puts --$searchResultList--
# puts [join $searchResultList <BR>]
#			LoopOverEntries $query2String $type $numberOfEntries $top $path $header $excludedFields 0 $numbering $outputFormat $cellBackgroundColors $page $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $returnButton $cssFileURL $nameFormat $nameSeparator $originalRepForSimilarity $imageFlag $alternateQuery $queryFieldType	;# uses searchResultList (global variable) - commented by GJFB on 2022-06-13
#			LoopOverEntries $query2String $type $numberOfEntries $top $path $header $excludedFields 0 $numbering $outputFormat $cellBackgroundColors $page $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $returnButton $cssFileURL $nameFormat $nameSeparator $originalRepForSimilarity $imageFlag $alternateQuery $queryFieldType $searchInputValue $childIdentifier $forceRecentFlag	;# added by GJFB on 2022-06-13
			LoopOverEntries $query2String $type $numberOfEntries $top $path $header $excludedFields 0 $numbering $outputFormat $cellBackgroundColors $page $includeReturnAddress $linkType $hideSimilarButton $targetValue $dateFieldName $siteFieldName $returnButton $cssFileURL $nameFormat $nameSeparator $originalRepForSimilarity $imageFlag $alternateQuery $queryFieldType $searchInputValue $childIdentifier $forceRecentFlag $forceHistoryBackFlag	;# added by GJFB on 2023-06-09
		}
	}
	
	if [regsub {^0} $numberOfEntries {$No} numberOfEntries] {
# no entries

		if {$numberOfSites == 1} {
			set singularSiteWarning "\${There is no contributor to be displayed for this data base.}"
			set singularSiteWarning2 "\${There is no reference to be displayed for this data base.}"
		} else {
			set singularSiteWarning "\${There is no contributor to be displayed for this data base, extracted from \$numberOfActiveSites
out of \$numberOfSites sites.}"
			set singularSiteWarning2 "\${There is no reference to be displayed for this data base, extracted from \$numberOfActiveSites
out of \$numberOfSites sites.}"
		}
		if $header {
			set queryForDisplay [MountQueryForDisplay $cgi(query)]	;# used in subst below
			
			if [regexp {en} $language] {
				set output [subst [subst [subst [subst $${top}Plural]]]]	;# needs currentProcedureName and currentProcedureFileName
			} else {
				set output [subst [subst [subst [subst $${top}Singular]]]]	;# needs currentProcedureName and currentProcedureFileName
			}
#			puts "<TABLE WIDTH=100%><TR><TD class=displayTD>"
			puts [SetFont $output]
#			puts </TD></TR></TABLE>\n
			set numberOfEntries 0
		} else {
			set numberOfEntries 0
			return {}
		}
	} else {
		if $header {
#			if {[info exists cgi(choice)] && $cgi(choice) == "fullbibtex"}
			if {[info exists cgi(choice)] && [regexp {fullXML} $cgi(choice)]} {
				puts {&lt;/metadatalist&gt;}	;# added by GJFB on 2020-06-17
				puts </PRE>
#				puts </FONT>
			}
		}
	}
	
	if $header {
# puts $env(REQUEST_URI)
# => /col/dpi.inpe.br/banon/1999/06.19.17.00/doc/mirrorsearch.cgi?languagebutton=pt-BR&targetframe=display___dpi_inpe_br__banon__1999__06_19_17_00&query=au+aragao
		if {![info exists cgi(choice)] || $cgi(choice) != "site"} {
# puts $env(REQUEST_URI)

# requestURI
			set requestURI {}
			if [info exists cgi(query)] {
				regsub -all {\&} $cgi(query) {%26} query	;# & is an alias for "and" in queries
				regsub -all {#} $query {%23} query	;# needed with queries incluing field names like #issn
				lappend requestURI query=$query
			}
			if [info exists cgi(languagebutton)] {lappend requestURI languagebutton=$cgi(languagebutton)}
#			if [info exists cgi(returnbutton)] {lappend requestURI returnbutton=$cgi(returnbutton)}
			if [info exists cgi(targetframe)] {lappend requestURI targetframe=$cgi(targetframe)}
			if [info exists cgi(choice)] {lappend requestURI choice=$cgi(choice)}
			if [info exists cgi(sort)] {lappend requestURI sort=$cgi(sort)}
			if [info exists cgi(accent)] {lappend requestURI accent=$cgi(accent)}
			if [info exists cgi(case)] {lappend requestURI case=$cgi(case)}
			set requestURI [join $requestURI &]
			regsub -all -- {\+} $requestURI {%2B} requestURI
			regsub -all { } $requestURI {+} requestURI
		
			if [string equal {Search} $option] {
				set requestURI /col/$currentRep/doc/mirrorsearch.cgi?$requestURI
			} elseif {[string equal {Contributors} $option]} {
				set requestURI /col/$currentRep/doc/mirror.cgi/Contributors?$requestURI
			}
	
#			puts "<TABLE WIDTH=100%><TR><TD class=displayTD>"
#			puts "<TABLE ALIGN=CENTER><TR><TD>"
# puts $requestURI
# puts [array get cgi]
			if [regexp {display___[^&$]*} $requestURI target] {
#				regsub {display___} $target {copy___} target2	;# commented by GJFB on 2020-07-09
				set target2 _blank	;# added by GJFB on 2020-07-09
				regsub $target $requestURI $target2 requestURI
				if $numberOfEntries {
					puts [CreateReturnButton <HR> $path$col/$languageRep2/doc/mirror ${path}mirror.cgi/About $display $Return http://$env(SERVER_NAME):$env(SERVER_PORT)$requestURI&continue=yes&returnbutton=no $target2 $Copy {} 1]
				} else {
					if [string equal {Recent} $option] {
						puts [CreateReturnButton <HR> $path$col/$languageRep2/doc/mirror ${path}mirror.cgi/About $display $Return http://$env(SERVER_NAME):$env(SERVER_PORT)$requestURI&continue=yes&returnbutton=no $target2 $Copy {} 1]
					} else {
						puts [CreateReturnButton <HR> $path$col/$languageRep2/doc/mirror ${path}mirror.cgi/About $display $Return]
					}
				}
			} else {
#				puts [CreateReturnButton <HR> $path$col/$languageRep2/doc/mirror ${path}mirror.cgi/About $display $Return]	;# commented by GJFB on 2021-09-29
				puts [CreateReturnButton <HR> $path$col/$languageRep2/doc/mirror {} $display $Return {} {} {} {} 1]	;# added by GJFB on 2021-09-29 to return to "Advanced Search" after an empty search result
			}
#			puts "</TD></TR></TABLE>"
		}
#		puts $fontTag2</BODY></HTML>
		puts $extraCode2	;# added by GJFB on 2019-10-13 for copying to clipboard
		puts <BR></BODY></HTML>
	} else {
		return $output2
	}
}

# CreateOutput - end
# ----------------------------------------------------------------------
# CreateReturnButton
# if the query info contains the expression &returnbutton=no
# then the return button is not created
# the button value2 (if any) is displayed first (at the left)
# example of imagePath: ../$col/$languageRep2/doc/mirror
# delayedReturnButton value is {}, yes or no
# if non empty, delayedReturnButton has priority over cgi(returnbutton)

proc CreateReturnButton {hr imagePath action1 target1 value1 {action2 {}} {target2 {}} {value2 {}} {warning {}} {useJavaScript 0} {delayedReturnButton {}}} {
	global env
	global cgi
	global administratorUserName	;# set in MirrorSearch or CreateMirror
	
	upvar col col
	upvar language language
	upvar languageRep1 languageRep1
	upvar languageRep2 languageRep2
	
# puts [info exists cgi(returnbutton)]
# puts $cgi(returnbutton)
# puts [CallTrace]
# puts $action1
# puts [array get cgi]

	if [string equal {} $delayedReturnButton] {
		if {[info exists cgi(returnbutton)] && [string equal {yes} $cgi(returnbutton)]} {set noButton 0} else {set noButton 1}
	} else {
		if [string equal yes $delayedReturnButton] {set noButton 0} else {set noButton 1}
	}
# puts $noButton
	if {$noButton && [regexp {^<[Hh][Rr]} $hr]} {
		if {[catch {global "${languageRep2}::Close"}] || ![info exists Close]} {
# appears in search result (with no return button)
#			set returnButton {<TABLE ALIGN=CENTER><TR><TD WIDTH=100><HR></TD></TR></TABLE>}
			set returnButton {<TABLE ALIGN=CENTER><TR><TD>&nbsp;</TD></TR><TR><TD WIDTH=180><HR></TD></TR></TABLE>}
		} else {
# Close is set in mirror/xxSubmit.tcl - used for submission/update confirmation only
			set returnButton "
<TABLE ALIGN=CENTER><TR><TD>&nbsp;</TD></TR><TR><TD WIDTH=180><HR></TD></TR></TABLE>
<TABLE ALIGN=CENTER>
	<TR>
		<FORM ACTION=\"javascript:window.close()\">
			<TD ALIGN=LEFT>
				<INPUT class=button TYPE=\"submit\" VALUE=\"$Close\">
			</TD>
		</FORM>
	</TR>
</TABLE>
"
		}
		return "
<!-- 1 -->
<!-- [CallTrace] -->
$returnButton
		"
	}

	if ![string equal {} $value2] {
		if 0 {
			if 0 {
# doesn't work - it opens a new window but it sends a wrong URL to the current window (Explorer 4.0)
		set button2 "
<FORM>
	<TD ALIGN=RIGHT>
	<INPUT class=button TYPE=\"image\" SRC=$imagePath/$value2.gif BORDER=0 ONCLICK=\"window.open('$action2', '$target2')\">
	</TD>
</FORM>
"
			}
			set button2 "
<TD ALIGN=RIGHT>
	<A HREF=$action2 ONCLICK=\"window.open('', '$target2', 'width=760,height=450,scrollbars=yes,menubar=yes,resizable=yes,toolbar=no')\" TARGET=\"$target2\"><IMG SRC=$imagePath/$value2.gif BORDER=0></A>
</TD>
"
		} else {
			if [regexp {&continue=yes} $action2] {
# continue button
				if 0 {
					set button2 "
<FORM NAME=search METHOD=POST ACTION=\"$action2\" TARGET=\"$target2\">
	<SCRIPT LANGUAGE=JavaScript>
		var password1 = LoadString(\"$administratorUserName\")
		if ([expr !$noButton] && password1 != null) {
			document.write (\"<INPUT class=button NAME=password1 TYPE=HIDDEN VALUE=\" + password1 + \">\")
		}
	</SCRIPT>
	<TD ALIGN=RIGHT>
		<INPUT class=button type=\"image\" src=\"$imagePath/$value2.gif\" BORDER=0>
	</TD>
</FORM>
"
				} else {
# BUTTON2
# puts $action2
					set button2 "
<FORM NAME=search METHOD=POST ACTION=\"$action2\" TARGET=\"$target2\">
	<SCRIPT LANGUAGE=JavaScript>
		var password1 = LoadString(\"$administratorUserName\")
		if (password1 != null) {
			document.write (\"<INPUT class=button NAME=password1 TYPE=HIDDEN VALUE=\" + password1 + \">\")
		}
	</SCRIPT>
	<TD ALIGN=RIGHT>
		<INPUT class=button TYPE=\"submit\" VALUE=\"$value2\">
	</TD>
</FORM>
"
				}
			} elseif {[string equal {$Print} $value2]} {
# print button
				if 0 {
					set button2 "
<SCRIPT LANGUAGE=JavaScript>
	var version = navigator.appVersion;
	if (version.substring(17, 26) == \"MSIE 4.01\") {
		document.write (\"<TD ALIGN=RIGHT><A HREF=$action2 TARGET='$target2'><IMG SRC=$imagePath/$value2.gif BORDER=0></A></TD>\");
	} else {
		document.write (\"<td align='right'>\$fontTag<a href='javascript:window.print()'><IMG SRC=$imagePath/$value2.gif BORDER=0></a>\$fontTag2</td>\");
	}
</SCRIPT>
"
				} else {
# BUTTON2
# used for the print button in Updating Confirmation (registration)
					set button2 "
<SCRIPT LANGUAGE=JavaScript>
	var version = navigator.appVersion;
	if (version.substring(17, 26) == \"MSIE 4.01\") {
		document.write (\"<FORM METHOD=POST ACTION='$action2' TARGET='$target2'><TD ALIGN='RIGHT' WIDTH=49%><INPUT class=button TYPE='submit' VALUE='$value2'></TD></FORM>\");
	} else {
		document.write (\"<FORM><TD ALIGN='RIGHT' WIDTH=49%><INPUT class=button TYPE='button' VALUE='$value2' ONCLICK='javascript:window.print()'></TD></FORM>\");
	}
</SCRIPT>
"
				}
			} else {
# other button
				if 0 {
					set button2 "
<TD ALIGN=RIGHT>
	<A HREF=$action2 TARGET=\"$target2\"><IMG SRC=$imagePath/$value2.gif BORDER=0></A>
</TD>
"
				} else {
# BUTTON2
					set button2 "
<FORM NAME=search METHOD=POST ACTION=\"$action2\" TARGET=\"$target2\">
	<SCRIPT LANGUAGE=JavaScript>
		var password1 = LoadString(\"$administratorUserName\")
		if ([expr !$noButton] && password1 != null) {
			document.write (\"<INPUT class=button NAME=password1 TYPE=HIDDEN VALUE=\" + password1 + \">\")
		}
	</SCRIPT>
	<TD ALIGN=RIGHT>
		<INPUT class=button TYPE=\"submit\" VALUE=\"$value2\">
	</TD>
</FORM>
"
				}
			}
		}
	}
# puts [info exists cgi(returnaddress)]
	if [info exists cgi(returnaddress)] {
# puts $cgi(returnaddress)
# => /col/dpi.inpe.br/banon/1999/06.19.17.00/doc/mirrorsearch.cgi?languagebutton=pt-BR&query=ti+tt
		set action1 $cgi(returnaddress)
#		set target1 {}	;# doesn't work when cancelling an update form
	}
	if ![regexp {\?} $action1] {
		set action1 $action1?languagebutton=$language
	} else {
# see Register option in CreateMirror (second display)
	}
	if $useJavaScript {
		if {![info exists cgi(returntoabout)] || \
			[string compare {no} $cgi(returntoabout)] == 0} {
# BUTTON1
			set button1 "
<FORM>
	<TD ALIGN=LEFT>
		<INPUT class=button TYPE=\"button\" VALUE=\"$value1\" ONCLICK=\"history.back()\">
	</TD>
</FORM>
"
		} elseif 1 {
# return to About this Mirror
# used after a submission with returnbutton == yes
			set button1 "
<FORM METHOD=POST ACTION=\"About?languagebutton=$language\" TARGET=\"$target1\">
	<TD ALIGN=LEFT>
		<INPUT class=button TYPE=\"submit\" VALUE=\"$value1\">
	</TD>
</FORM>
"
		} elseif 1 {
			set button1 "
<TD ALIGN=LEFT>
	<A HREF=\"JavaScript:history.back()\"><IMG SRC=$imagePath/$value1.gif BORDER=0></A>
</TD>
"
		} else {
# doesn't work with ie 5 and higher - history.back() returns the same page
			set button1 "
<FORM>
	<TD ALIGN=LEFT>
		<INPUT class=button TYPE=\"image\" SRC=$imagePath/$value1.gif BORDER=0 ONCLICK=\"history.back()\">
	</TD>
</FORM>
"
		}
	} else {
# don't use JavaScript
		if 0 {
			set button1 "
<TD ALIGN=LEFT>
	<A HREF=$action1 TARGET=\"$target1\"><IMG SRC=$imagePath/$value1.gif BORDER=0></A>
</TD>
"
		} else {
# BUTTON1
# puts $action1

			set button1 "
<FORM METHOD=POST ACTION=\"$action1\" TARGET=\"$target1\">
	<TD ALIGN=LEFT>
		<INPUT class=button TYPE=\"submit\" VALUE=\"$value1\">
	</TD>
</FORM>
"
		}
	}
	set string $hr
	if [regexp {^<[Hh][Rr]} $hr] {
# appears in search result (with return button)
		set string "<TABLE ALIGN=CENTER><TR><TD>&nbsp;</TD></TR><TR><TD WIDTH=180><HR></TD></TR></TABLE>"
		append string \n
	}
	append string {<TABLE ALIGN=CENTER><TR>}
	if ![string equal {} $value2] {
		append string $button2
	}
	if {!$noButton || [regexp {^<[Hh][Rr]} $hr]} {append string $button1}
	if ![string equal {} $value2] {
		append string "</TR><TR><TD COLSPAN=2 ALIGN=CENTER>$warning</TD>"
	}
	append string {</TR></TABLE>}
if 0 {
	return $string
} else {
	return "
<!-- 2 -->
<!-- [CallTrace] -->
$string
	"
}
}

# CreateReturnButton - end
# ----------------------------------------------------------------------
# ComputeSiteList
# Returns a site list made of the local site and the sites
# defined in the col/$mirrorRep/doc/@siteList.txt file
# if this file doesn't exist or mirrorRep is empty, then the default file
# col/$env(LOBIMIREP)/doc/@siteList.txt is used instead
# Compute siteList is similar to a code in MultipleSubmit
# ComputeSiteList is used in CreateOutput (with type == site), Statistics and DisplayDocContent
# mirrorRep is the name of the repository containing the
# @siteList.txt file of interest (it is not necessarily a mirror repository)

proc ComputeSiteList {{mirrorRep {}}} {
	global env
	
# serverAddress
	set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
	set colPath $env(DOCUMENT_ROOT)
	if [string equal {} $mirrorRep] {
		Load $colPath/col/$env(LOBIMIREP)/doc/@siteList.txt fileContent
	} else {
		if [file exists $colPath/col/$mirrorRep/doc/@siteList.txt] {
			Load $colPath/col/$mirrorRep/doc/@siteList.txt fileContent
		} else {
			Load $colPath/col/$env(LOBIMIREP)/doc/@siteList.txt fileContent
		}
	}
	set fileContent [string trim $fileContent]
	regsub -all "\n+" $fileContent "\n" fileContent
	set siteRepIpList [split $fileContent \n]
	set siteList [list $serverAddress]
	foreach siteRepIp $siteRepIpList {
		foreach {site loCoInRep ip} $siteRepIp {break}
#		regexp {:(.*)} $site m serverPort
#		lappend siteList $ip:$serverPort
		lappend siteList $site
	}
	return $siteList
# => {md-m09.sid.inpe.br 800} {md-m09b.sid.inpe.br 802} mtc-m12.sid.inpe.br:80 
}

# ComputeSiteList - end
# ----------------------------------------------------------------------
# FindLanguage
# Find the language preference (see its definition in FindPreferredLanguage)
#
# Sets the mirrorHomePageRep global variable.
# >>> The mirrorRep (e.g., loBiMiRep) service/reference must contain
# a reference to a mirrorHomePageRep
# Finds the language for the current mirror page.
# >>> The mirrorHomePageRep service/reference must contain a reference
# to the first language repository.
# The other language repositories containing translations of the content
# of the first language repository, must have a reference to the
# first language repository (contained in service/reference).

proc FindLanguage {mirrorRep} {
	global env
	global cgi
	global mirrorHomePageRep	;# set in this procedure
	global homePath

# StoreLog {notice} {FindLanguage} [array get cgi]

#	set sync 1	;# sync
	set sync 0	;# not async - needed, otherwise the html page or frame is not displayed (a blank page or frame is displayed) in bibdigital

# set xxx [CallTrace]
# Store xxx C:/tmp/bbb.txt auto 0 a 
	
	if ![file isdirectory $homePath/col/$mirrorRep] {
		error "FindLanguage: '$mirrorRep' is not a repository \nin the '$homePath' collection."
	}
	
# languageButton
	set languageButton {}

#	if {[info exists env(QUERY_STRING)] && [string compare {} $env(QUERY_STRING)] != 0}
# catch must be used in place of info exists because [info exists env(QUERY_STRING)] is
# always 1, even if env(QUERY_STRING) doesn't exist (this happens when FindLanguage is called from post)
	if [info exists cgi(languagebutton)] {
# used by ProcessReview
		set languageButton $cgi(languagebutton)
#	# elseif {[info exists cgi(ibiurl.backgroundlanguage)]} #
#		set languageButton $cgi(ibiurl.backgroundlanguage)	;# ibiurl.backgroundlanguage is alias for languagebutton
	} elseif {![catch {expr ![string equal {} $env(QUERY_STRING)]} flag] && $flag} {
		if ![regexp {languagebutton=([^&]*)} $env(QUERY_STRING) m languageButton] {
			regexp {ibiurl.backgroundlanguage=([^&]*)} $env(QUERY_STRING) m languageButton	;# ibiurl.backgroundlanguage is alias for languagebutton
		}
	}

# puts $env(LANGUAGE_PREFERENCE)
# => urlib.net/www/2011/03.29.20.55,languagePreference pt-BR dpi.inpe.br/banon-pc2@80/2006/07.17.20.31,languagePreference en
	array set languagePreferenceArray $env(LANGUAGE_PREFERENCE)
	if {![info exists languagePreferenceArray($mirrorRep,languagePreference)] || \
	[string equal {} $languagePreferenceArray($mirrorRep,languagePreference)]} {
# use the preference set in the browser
		if [info exists env(HTTP_ACCEPT_LANGUAGE)] {
			set languagePreference $env(HTTP_ACCEPT_LANGUAGE)	;# ex: pt-br,en;q=0.5
		} else {
			set languagePreference {}
		}
	} else {
# use the preference set in the dislayControl.tcl files
		set languagePreference $languagePreferenceArray($mirrorRep,languagePreference)
	}
# puts $languagePreference

## dpi.inpe.br/banon/2000/01.23.20.24 is the default mirror home page repository
#	set mirrorHomePageRepository dpi.inpe.br/banon/2000/01.23.20.24

#	set localURLibClientSocketId [StartCommunication $env(SERVER_NAME) $env(URLIB_PORT)]
	set localURLibClientSocketId [StartCommunication $env(SERVER_NAME) $env(URLIB_PORT) $sync]

# global clicks
# set xxx FindLanguage(1)-$clicks
# Store xxx C:/tmp/bbb.txt binary 0 a

# mirrorHomePageRep
	set mirrorHomePageRep [Submit $localURLibClientSocketId [list GetCitedRepositoryList $mirrorRep] $sync]
#	set mirrorHomePageRep [Submit $localURLibClientSocketId [list GetCitedRepositoryList $mirrorRep] 0 $clicks]	;# not async - needed, otherwise the html page or frame is not displayed (a blank page or frame is displayed) in bibdigital

# set xxx FindLanguage(2)-$clicks
# Store xxx C:/tmp/bbb.txt binary 0 a

# puts --$mirrorRep--
# puts --$mirrorHomePageRep--

	set parentRepList [Submit $localURLibClientSocketId [list GetCitedRepositoryList $mirrorHomePageRep 1] $sync]

# puts --$parentRepList--
	if {[string equal {} $mirrorHomePageRep] || 0 && [string equal {} $parentRepList]} {	;# 0 added by GJFB on 2025-01-03
# if referenceTable is corrupted then GetCitedRepositoryList might return empty
# consequently parentRepList below will be empty and language will not be created
#		puts {Content-Type: text/html}
#		puts {}
		puts "
<HTML>
	<HEAD>
		<TITLE>Mirror Home Page Construction Warning</TITLE>
	</HEAD>
	<BODY BGCOLOR=\"#F8F8D2\">
		<P ALIGN=CENTER><FONT size=+0><I>Mirror Home Page Construction Warning</I></FONT></P>
		<P>
			The mirror home page construction is incomplete or the referenceTable file has been corrupted.
		</P>
		<P>
			To know how to customize the Bibliographic Mirror, open the
			User's Guide chapter <A HREF=goto-/iconet.com.br/banon/2001/04.28.19.50>
			Customizing the Bibliographic Mirror</A>.
			<BR>
			To recreate the referenceTable file, post the local collection with the option -r.</P>
		</P>
	</BODY>
</HTML>
		"
		close $localURLibClientSocketId
		exit
	}

	foreach rep $parentRepList {
		if [TestContentType $rep "Submission Form" $env(DOCUMENT_ROOT)] {
# a Submission Form
			set submissionFormRep $rep
			set citedRepositoryList [Submit $localURLibClientSocketId \
			[list GetCitedRepositoryList $submissionFormRep 1] $sync]
			set submissionFormFirstLanguageRep {}
			foreach citedRepository $citedRepositoryList {
				set targetFile [Submit $localURLibClientSocketId \
				[list GetTargetFile $citedRepository] $sync]
				if [regexp {FillingInstructions\.tcl$} $targetFile] {
# submissionFormFirstLanguageRep must contain the target file xxFillingInstructions.tcl
# submissionFormFirstLanguageRep
					set submissionFormFirstLanguageRep $citedRepository
					break
				}
			}
# puts {Content-Type: text/html}
# puts {}
# puts [list FindPreferredLanguage $submissionFormFirstLanguageRep FillingInstructions.tcl $languagePreference $languageButton]
# >>> returns an error message if any
# puts [Submit $localURLibClientSocketId \
# [list FindPreferredLanguage $submissionFormFirstLanguageRep FillingInstructions.tcl \
# $languagePreference $languageButton]]

			foreach {submissionFormLanguage submissionFormLanguageRep} [Submit $localURLibClientSocketId \
			[list FindPreferredLanguage $submissionFormFirstLanguageRep FillingInstructions.tcl \
			$languagePreference $languageButton] $sync] {break}
		} else {
# not a Submission Form
			set firstLanguageRep $rep
# LANGUAGE (see its definition in FindPreferredLanguage)
# language
# puts --$languageButton--
# puts $languagePreference
# => pt-BR,pt;q=0.9,en-US;q=0.8,en;q=0.7
# StoreLog {notice} {FindLanguage} [CallTrace]
# StoreLog {notice} {FindLanguage} [list FindPreferredLanguage $firstLanguageRep Index.html $languagePreference $languageButton]
# >>>>> xxIndex.html MUST BE the target file of firstLanguageRep <<<<<
			set preferredLanguage [Submit $localURLibClientSocketId \
			[list FindPreferredLanguage $firstLanguageRep Index.html \
			$languagePreference $languageButton] $sync]
# set xxx --$preferredLanguage--	;# may contain an error message
# Store xxx {C:/Users/Gerald Banon/tmp/bbb.txt} binary 0 a
# puts --$preferredLanguage--	;# may contain an error message
			foreach {language languageRep} $preferredLanguage {break}
		}
	}

	if [info exists submissionFormRep] {
		if [string  equal {} $submissionFormFirstLanguageRep] {
# there is no submission form first language repository
			if [info exists language] {	;# if added by GJFB on 2025-01-02
				set submissionFormLanguage $language
				set submissionFormLanguageRep $languageRep
			} else {
# added by GJFB on 2025-01-02 to avoid adding the default english language repository option as a parent repository for a Submission Form content type repository
# use the default language (en) - ex: id 8JMKD3MGP8W/35HKRAP
				set language en
				set submissionFormLanguage $language
				set languageRep dpi.inpe.br/banon/1999/05.03.22.11
				set submissionFormLanguageRep $languageRep
				set firstLanguageRep $languageRep
			}
		}
	} else {
# there is no submission form repository
		set submissionFormRep $mirrorHomePageRep
		if [info exists language] {	;# if added by GJFB on 2025-01-03
			set submissionFormLanguage $language
			set submissionFormLanguageRep $languageRep
		} else {
# added by GJFB on 2025-01-03 to avoid adding the default english language repository option as a parent repository for a 'mirror home page' repository
# use the default language (en) - ex: id 83LX3pFwXQZ4dqvktTY/L2Qpi
			set language en
			set submissionFormLanguage $language
			set languageRep dpi.inpe.br/banon/1999/05.03.22.11
			set submissionFormLanguageRep $languageRep
			set firstLanguageRep $languageRep
		}
		set submissionFormFirstLanguageRep $languageRep	;# added by GJFB on 2013-06-06 - needed to display the Mirror Home Page Construction Warning
	}

	close $localURLibClientSocketId

if 0 {
 puts "
 	[info exists submissionFormRep]
 	--$submissionFormFirstLanguageRep--
 "
 exit
}

	if ![info exists language] {	;# if added by GJFB on 2025-02-21 to avoid an Internal Server Error (500) when the default language version for the mirror home page has not be set has a parent repository of the mirror home page and there is a submission form repository has a parent repository of the mirror home page
		puts {Content-Type: text/html}
		puts {}
		puts "
<HTML>
	<HEAD>
		<TITLE>Mirror Home Page Construction Warning</TITLE>
	</HEAD>
	<BODY BGCOLOR=\"#F8F8D2\">
		<P ALIGN=CENTER><FONT size=+0><I>Mirror Home Page Construction Warning</I></FONT></P>
		<P>
			<FONT size=-1>
				The mirror home page is under construction.
				<BR>
				The repository of the default language version for the mirror home page has not be defined.
				<br>
				For example, the repository dpi.inpe.br/banon/1999/05.03.22.11 should be set has a parent repository for the mirror home page.
			</FONT>
		</P>
		<P>
			To know how to customize the Bibliographic Mirror, open the
			User's Guide chapter <A HREF=goto-/iconet.com.br/banon/2001/04.28.19.50>
			Customizing the Bibliographic Mirror</A>.
		</P>
	</BODY>
</HTML>
		"
		exit
	}
 
	if {0 || $language == "" || $submissionFormLanguage == ""} {
#		puts {Content-Type: text/html}
#		puts {}
		puts "
<HTML>
	<HEAD>
		<TITLE>Mirror Home Page Construction Warning</TITLE>
	</HEAD>
	<BODY BGCOLOR=\"#F8F8D2\">
		<P ALIGN=CENTER><FONT size=+0><I>Mirror Home Page Construction Warning</I></FONT></P>
		<P>
			<FONT size=-1>
				The mirror home page is under construction.
				<BR>
				firstLanguageRep = \"$firstLanguageRep\"
				<BR>
				language = \"$language\"
				<BR>
				languageRep = \"$languageRep\"
				<BR>
				submissionFormRep = \"$submissionFormRep\"
				<BR>
				submissionFormFirstLanguageRep = \"$submissionFormFirstLanguageRep\"
				<BR>
				submissionFormLanguage = \"$submissionFormLanguage\"
				<BR>
				submissionFormLanguageRep = \"$submissionFormLanguageRep\"
			</FONT>
		</P>
		<P>
			To know how to customize the Bibliographic Mirror, open the
			User's Guide chapter <A HREF=goto-/iconet.com.br/banon/2001/04.28.19.50>
			Customizing the Bibliographic Mirror</A>.
		</P>
	</BODY>
</HTML>
		"
		exit
	}

	if [file exists $homePath/col/$languageRep/doc/mirror/${language}About.tcl] {
# default mirror
		set languageRep1 $languageRep	;# for .html files - for customization
		set languageRep2 $languageRep	;# for the other files - for default
	} else {
# customized mirror (doesn't contain the mirror directory)
## serverAddress
#		set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# serverAddressWithIP
		set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
#		set citedRepositoryList [Execute $serverAddress [list GetCitedRepositoryList $languageRep]]
		set citedRepositoryList [Execute $serverAddressWithIP [list GetCitedRepositoryList $languageRep]]
		foreach citedRepository $citedRepositoryList {
#			if [file exists ../$col/$citedRepository/doc/mirror/${language}About.tcl]
			if [file exists $homePath/col/$citedRepository/doc/mirror/${language}About.tcl] {
#				source ../$col/$citedRepository/doc/mirror/${language}About.tcl
				source $homePath/col/$citedRepository/doc/mirror/${language}About.tcl
				break
			}
		}
		set languageRep1 $languageRep	;# for .html files - for customization
		set languageRep2 $citedRepository	;# for the other files - for default
	}

# puts {Content-Type: text/html}
# puts {}
# puts [list $language $languageRep1 $languageRep2 $firstLanguageRep $submissionFormRep $submissionFormLanguage $submissionFormLanguageRep]
# exit

	return [list $language $languageRep1 $languageRep2 $firstLanguageRep $submissionFormRep $submissionFormLanguage $submissionFormLanguageRep]
}

# FindLanguage - end
# ----------------------------------------------------------------------
# FindLanguageForSubmissionForm
# language and submissionFormLanguage may be different
# in this case we need to recompute languageRep2
# used in CreateMirror (Submit option) and Confirm

proc FindLanguageForSubmissionForm {language submissionFormLanguage firstLanguageRep languageRep2} {
	global serverAddressWithIP
	if ![string equal $language $submissionFormLanguage] {
# language and submissionFormLanguage may be different
		foreach {language languageRep2} [Execute $serverAddressWithIP \
		[list FindPreferredLanguage $firstLanguageRep Index.html \
		{} $submissionFormLanguage]] {break}
	}
	return [list $language $languageRep2]
}

# FindLanguageForSubmissionForm - end
# ----------------------------------------------------------------------
# CreateBannerSpace
# let b1 be the number of big banners in site 1
# let s1 be the number of small banners in site 1
# let b2 be the number of big banners in site 2
# let s2 be the number of small banners in site 2
# the probability of displaying (at one click)
# a given big banner of site 1 is:
# (1/2)*(1/(b1  + s1))
# the probability of displaying (at one click)
# a given small banner of site 1 is:
# (1/2)*(1/(b1  + s1)) + (1/2)*(s2/(b2  + s2))*(1/s1)

proc CreateBannerSpace {languageRep2 language} {
	global env
	global bannerRoot
	
	set URLibServiceRepository $env(URLIB_SERVICE_REP)
# site
#	set site $env(HTTP_HOST)
#	set site $env(SERVER_NAME):$env(SERVER_PORT)
	set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
	set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
	set localSite [ReturnHTTPHost $serverAddress]
	set colPath $env(DOCUMENT_ROOT)
	set urlibServerAddress $env(URLIB_SERVER_ADDR)	;# www.urlib.net and port
	set urlibadEMailAddress [Execute $serverAddressWithIP GetURLibAdEMailAddress]
#	set urlibadEMailAddress [GetURLibAdEMailAddress]
#	Load $colPath/col/$URLibServiceReposi'tory/auxdoc/nextSite i
	Load $env(BANNER_ROOT)/nextSite i
	if {$i ==  ""} {set i 0}
	if {$i ==  0} {
# remote site is urlibServerAddress
# alternativeSite
		set alternativeSite $serverAddress
		foreach {address1 size} [FindBannerAddress $language $urlibServerAddress {} $alternativeSite] {break}
		if {$address1 == ""} {
# no banner to display
			return {
<HTML><HEAD><TITLE>Bibliographic Mirror</TITLE></HEAD>
<BODY BGCOLOR="#8888CC"></BODY></HTML>
}
		}
		if [regexp "^$localSite" $address1] {
			set e-mailAddress1 $env(SERVER_ADMIN)
		} else {
			set e-mailAddress1 $urlibadEMailAddress
		}
		if {$size == "Small"} {
# small
			foreach {address2 size} [FindBannerAddress $language $serverAddress Small] {break}
			if {$address2 == ""} {
# no banner to display
				return {
<HTML><HEAD><TITLE>Bibliographic Mirror</TITLE></HEAD>
<BODY BGCOLOR="#8888CC"></BODY></HTML>
}
			}
			set e-mailAddress2 $env(SERVER_ADMIN)
			set output {	
<HTML>
<HEAD>
<TITLE>Banner Space</TITLE>
</HEAD>
<FRAMESET COLS="50%,50%" BORDER=1 FRAMEBORDER=NO>
	<FRAMESET ROWS="75%,25%" BORDER=1 FRAMEBORDER=NO>
		<FRAME SRC="http://$address1" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
		<FRAME SRC="http://$localSite/advertising.cgi?languagerep=$languageRep2&languagebutton=$language&emailaddress=${e-mailAddress1}" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
	</FRAMESET>
	<FRAMESET ROWS="75%,25%" BORDER=1 FRAMEBORDER=NO>
		<FRAME SRC="http://$address2" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
		<FRAME SRC="http://$localSite/advertising.cgi?languagerep=$languageRep2&languagebutton=$language&emailaddress=${e-mailAddress2}" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
	</FRAMESET>
</FRAMESET>
<NOFRAMES>
Your browser cannot display frames.
</NOFRAMES>
</HTML>
}
		} else {
# big
#			puts "Location: http://$address1"
#			puts ""
#			set output {}
			set output {	
<HTML>
<HEAD>
<TITLE>Banner Space</TITLE>
</HEAD>
<FRAMESET ROWS="75%,25%" BORDER=1 FRAMEBORDER=NO>
	<FRAME SRC="http://$address1" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
	<FRAME SRC="http://$localSite/advertising.cgi?languagerep=$languageRep2&languagebutton=$language&emailaddress=${e-mailAddress1}" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
</FRAMESET>
<NOFRAMES>
Your browser cannot display frames.
</NOFRAMES>
</HTML>
}
		}
		set i 1
	} else {
# local site
		foreach {address2 size} [FindBannerAddress $language $serverAddress {}] {break}
		if {$address2 == ""} {
# no banner to display
			return {
<HTML><HEAD><TITLE>Bibliographic Mirror</TITLE></HEAD>
<BODY BGCOLOR="#8888CC"></BODY></HTML>
}
		}
		set e-mailAddress2 $env(SERVER_ADMIN)
		if {$size == "Small"} {
# small
# alternativeSite
#			set alternativeSite $env(SERVER_NAME):$env(SERVER_PORT)
			set alternativeSite $serverAddressWithIP
			foreach {address1 size} [FindBannerAddress $language $urlibServerAddress Small $alternativeSite] {break}
			if {$address1 == ""} {
# no banner to display
				return {
<HTML><HEAD><TITLE>Bibliographic Mirror</TITLE></HEAD>
<BODY BGCOLOR="#8888CC"></BODY></HTML>
}
			}
			if [regexp "^$localSite" $address1] {
				set e-mailAddress1 $env(SERVER_ADMIN)
			} else {
				set e-mailAddress1 $urlibadEMailAddress
			}
			set output {	
<HTML>
<HEAD>
<TITLE>Banner Space</TITLE>
</HEAD>
<FRAMESET COLS="50%,50%" BORDER=1 FRAMEBORDER=NO>
	<FRAMESET ROWS="75%,25%" BORDER=1 FRAMEBORDER=NO>
		<FRAME SRC="http://$address1" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
		<FRAME SRC="http://$localSite/advertising.cgi?languagerep=$languageRep2&languagebutton=$language&emailaddress=${e-mailAddress1}" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
	</FRAMESET>
	<FRAMESET ROWS="75%,25%" BORDER=1 FRAMEBORDER=NO>
		<FRAME SRC="http://$address2" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
		<FRAME SRC="http://$localSite/advertising.cgi?languagerep=$languageRep2&languagebutton=$language&emailaddress=${e-mailAddress2}" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
	</FRAMESET>
</FRAMESET>
<NOFRAMES>
Your browser cannot display frames.
</NOFRAMES>
</HTML>
}
		} else {
# big
#			puts "Location: http://$address2"
#			puts ""
#			set output {}
			set output {	
<HTML>
<HEAD>
<TITLE>Banner Space</TITLE>
</HEAD>
<FRAMESET ROWS="75%,25%" BORDER=1 FRAMEBORDER=NO>
	<FRAME SRC="http://$address2" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
	<FRAME SRC="http://$localSite/advertising.cgi?languagerep=$languageRep2&languagebutton=$language&emailaddress=${e-mailAddress2}" MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
</FRAMESET>
<NOFRAMES>
Your browser cannot display frames.
</NOFRAMES>
</HTML>
}
		}
		set i 0
	}
# set i 0	;# useful to test the banner space
#	Store i $colPath/col/$URLibServiceRepository/auxdoc/nextSite
	Store i $env(BANNER_ROOT)/nextSite auto 0 w 1
	return [subst $output]
}
	
# CreateBannerSpace - end
# ----------------------------------------------------------------------
# FindBannerAddress
# Examples:
# FindBannerAddress $language $remoteSite $alternativeSite
# FindBannerAddress $language $site
# alternativeSite is usually the current server address
# size values are Big, Small or {}
# called by CreateBannerSpace which is called in cgi scripts only

proc FindBannerAddress {language site size {alternativeSite {}}} {
	global col
	global searchResultList
	global numberOfSites
	global numberOfSatisfiedQueries
## the two lines below are not used because of the last argument in MultipleSubmit
#	upvar environment environment ;# used in MultipleSubmit
#	upvar currentRep currentRep ;# used in MultipleSubmit
	set query [list list FindBannerPath $language $size]
# MULTIPLE SUBMIT
	set searchResultList {}
	MultipleSubmit {} $query searchResultList 0 [list $site]
	set bannerPath $searchResultList
	if {$numberOfSatisfiedQueries == 1} {
		if {$bannerPath != ""} {
#			regexp "../$col/col/(.*)/doc/@${language}(.*)Banner.html" \
				$bannerPath m bannerRep size
			regexp "../$col/col/(.*)/doc/.*(Small|Big)Banner.html" \
				$bannerPath m bannerRep size
			set address [ReturnHTTPHost $site]/rep-/$bannerRep
			return [list $address $size]
		}
	} else {
		if {$alternativeSite != ""} {
			return [FindBannerAddress $language $alternativeSite $size]
		}
	}
# no banner found
	return [list {} $size]
}

# FindBannerAddress - end
# ----------------------------------------------------------------------
# GetBg
# GetBg get bgcolor, background and bgProperties from the file mirrorStandard.css
# GetBg2 get bgcolor, background and bgProperties from the file About.html

proc GetBg {languageRep1 language} {
	set col ../../../../..
# puts [list ../$col/$languageRep1/doc/mirrorStandard.css]
	Load ../$col/$languageRep1/doc/mirrorStandard.css fileContent
	if [regexp {[bB][oO][dD][yY][^\{]*\{([^\}]*)\}} $fileContent m bodyValue] {
		foreach item [split $bodyValue {;}] {
			regsub {:} $item { } item ;# font-family: Verdana, Arial -> font-family Verdana, Arial
			set item1 [lindex $item 0]	;# font-family
			set item2 [lrange $item 1 end]	;# Verdana, Arial
			array set body [list $item1 $item2]
		}
if 1 {
		ConditionalSet bgColor body(background-color) #DDDDDD
#		ConditionalSet background body(background-image) {}
#		ConditionalSet bgProperties body(background-attachment) {}
		set background {}
		set bgProperties {}
} else {
# not used
		set bgColor #DDDDDD
		set background {}
		set bgProperties {}
}
		ConditionalSet face body(font-family) {}
		ConditionalSet size body(font-size) {}
		if {[string compare {} $face] != 0 && \
			[string compare {10pt} $size] == 0} {
			set fontTag "<FONT FACE='$face' SIZE=2>"
			set fontTag2 {</FONT>}
		} else {
			set fontTag {}
			set fontTag2 {}
		}
	} else {
		return [GetBg2 $languageRep1 $language]
	}
	return [list $bgColor $background $bgProperties $fontTag $fontTag2]
}

proc GetBg2 {languageRep1 language} {
	set col ../../../../..
# puts [list ../$col/$languageRep1/doc/${language}About.html]
	Load ../$col/$languageRep1/doc/${language}About.html fileContent
	set rest {}
	if [regexp {(<[bB][oO][dD][yY][^>]*>)(.*)$} $fileContent m bodyTag rest] {
		if ![regexp {[bB][gG][cC][oO][lL][oO][rR]="?([^"> ]*)"?} $bodyTag m bgColor] {
# " bgcolor not found
			set bgColor #DDDDDD
		}
		if ![regexp {[bB][aA][cC][kK][gG][rR][oO][uU][nN][dD]="?([^"> ]*)"?} $bodyTag m background] {
# " background not found
			set background {}
		}
		if ![regexp {[bB][gG][pP][rR][oO][pP][eE][rR][tT][iI][eE][sS]="?([^"> ]*)"?} $bodyTag m bgProperties] {
# " bgproperties not found
			set bgProperties {}
		}
	} else {
		set bgColor #DDDDDD
		set background {}
		set bgProperties {}
	}
# get the font tag (it must be the first tag)
	if [regexp {^[ 	\n]*(<[fF][oO][nN][tT][^>]*>)} $rest m fontTag] {
		regsub -all {"} $fontTag {'} fontTag	;# for JavaScript "
		set fontTag2 {</FONT>}
	} else {
		set fontTag {}
		set fontTag2 {}
	}
# puts --$fontTag--
	return [list $bgColor $background $bgProperties $fontTag $fontTag2]
}

# GetBg - end
# ----------------------------------------------------------------------
# GetFrameName

proc GetFrameName {{prefix {display}}} {
	upvar currentRep currentRep
	regsub -all {/} ${prefix}___$currentRep {__} display
	regsub -all {\.|@|-} $display {_} display
	return $display
}

# GetframeName - end
# ----------------------------------------------------------------------
# ReturnURLPropertyList2
# calls ReturnURLPropertyList
# if ReturnURLPropertyList returns an empty list then ReturnURLPropertyList2 tries in the scope of all sites
# from the URLib Server (urlib.net)
# called by ResolveIBI only
# criterionList is produced in ResolveIBI
# criterionList is a list for an array (see ReturnURLPropertyList)
# useURLibServerFlag value is 0 or 1, 1 means to find directly through the URLib server - used in FindSite2 (was used in SetAttributeTable)
# >>> from 2021-10-09 ResolveIBI is used just with useURLibServerFlag value 0
# useLocalServerOnlyFlag value is 0 or 1, 1 means to use the local server only (never use the URLib server) - used only when the agency structure is enabled (takes precedence over useURLibServerFlag)
# extendedSearchFlag value is 0 (default) or 1 - 1 means to extend the search to Federated Archives
# extendedSearchFlag is set in BuildReturnPathArray (see get.tcl) and used in FindURLPropertyList2

# returns empty or a list of url properties of the unique repositoriy satisfying the criterion list
# (see ReturnURLPropertyList)

proc ReturnURLPropertyList2 {criterionList useURLibServerFlag {useLocalServerOnlyFlag 0} {extendedSearchFlag 0}} {
	global env	;# for cgi script
	global serverAddress	;# for non cgi script - when executing FindCopyrightRepositories
	global serverAddressWithIP	;# for non cgi script - when executing UpdateArchivingPolicy in utilities2.tcl or CreateFullBibINPEEntry
	global urlibServerAddress	;# www.urlib.net and port - set in LoadGlobalVariables
	global standaloneModeFlag	;# set in LoadGlobalVariables
	global cgi	;# added by GJFB on 2021-10-08 - may be set in Get and Get-

if $extendedSearchFlag {
# >>> to see the puts output go to the bottom of the source code page of the upper menu
#	puts [CallTrace]
}	
if 0 {
	puts {Content-Type: text/html}
	puts {}
	puts [CallTrace]
}
# set clicks [clock clicks]
# puts $clicks-$criterionList<BR>
# puts $useURLibServerFlag

#	if [info exists env(IP_ADDR)] #	;# commented by GJFB on 2016-09-11 - env(SERVER_NAME) may exist while env(IP_ADDR) may not
	if [info exists env(SERVER_NAME)] {
# the calling procedure is a cgi script
		set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
		set urlibServerAddress $env(URLIB_SERVER_ADDR)	;# www.urlib.net and port
		set standaloneModeFlag $env(STANDALONE_MODE_FLAG)
# puts $cgi(linktype)
	} else {
# the calling procedure is not a cgi script
	}

# set useURLibServerFlag 1	;# for testing
	foreach {serverName urlibPort} [ReturnCommunicationAddress $serverAddress] {break}
if 1 {
#	if $useURLibServerFlag 	# ;# commented by GJFB on 2017-02-20
	if {$useURLibServerFlag && !$useLocalServerOnlyFlag} { 	;# added by GJFB on 2017-02-20
# use the URLib server and don't use agency structure
		set urlPropertyList {{}}
	} else {
# don't use the URLib server or use agency structure
#		set urlPropertyList [ReturnURLPropertyList $criterionList]	;# returns from the current site - the current site may be the urlib.net site - commented by GJFB on 2021-02-16
		set urlPropertyList [ReturnURLPropertyList $criterionList $extendedSearchFlag]	;# returns from the current site - the current site may be the urlib.net site - added by GJFB on 2021-02-16
# 		set urlPropertyList {}	;# for testing non script
# puts --$urlPropertyList--	;# may contain an error message - to display it turn the above if 0 to if 1
# puts --$clicks-$urlPropertyList--<BR><BR>	
#		return [join $urlPropertyList]
	}
} else {
# tested but not in use
# to use it set useURLibServerFlag to 1 when calling ResolveIBI - was tested by GJFB on 2021-02-16 for Federated Archives that have agreed to share the same group value standard to grant them to find the nexthigher records by using urlib.net
# >>> here it is assumed that the complete host name without domain doesn't contain any periods (.)
	if {$useURLibServerFlag && !$useLocalServerOnlyFlag && [regexp {\.} $serverName]} { 	;# added by GJFB on 2021-02-16
# use the URLib server and don't use the agency structure and the local server has a domain name
		set urlPropertyList {{}}
	} else {
#		set urlPropertyList [ReturnURLPropertyList $criterionList]	;# returns from the current site - the current site may be the urlib.net site - commented by GJFB on 2021-02-16
		set urlPropertyList [ReturnURLPropertyList $criterionList $extendedSearchFlag]	;# returns from the current site - the current site may be the urlib.net site - added by GJFB on 2021-02-16
# 		set urlPropertyList {}	;# for testing non script
# puts --$urlPropertyList--	;# may contain an error message - to display it turn the above if 0 to if 1
# puts --$clicks-$urlPropertyList--<BR><BR>	
#		return [join $urlPropertyList]
	}
}
#	if ![string equal {{}} $urlPropertyList] {
#		array set urlPropertyArray [join $urlPropertyList]
#		set deletedFlag [string equal {Deleted} $urlPropertyArray(state)]
#	}
	
#	if {[string equal {{}} $urlPropertyList] || $deletedFlag} #	;# commented by GJFB on 2015-02-16 - if the original has been deleted then the copies should not be considered because they cannot be authenticated anymore
#	if [string equal {{}} $urlPropertyList] # ;# commented by GJFB on 2017-02-20
# puts $useLocalServerOnlyFlag
#	if {[string equal {{}} $urlPropertyList] && !$useLocalServerOnlyFlag} # 	;# added by GJFB on 2017-02-20 - commented by GJFB on 2021-10-08
	if {[string equal {{}} $urlPropertyList] && (!$useLocalServerOnlyFlag || [info exists cgi(linktype)])} { 	;# added by GJFB on 2021-10-08 - change made to solve the resolution of relative links
# not found in the current site or deleted and (don't use agency structure or use relative link)
# puts "not found in the current site or deleted"
# puts $standaloneModeFlag
		if !$standaloneModeFlag {
# not in standalone mode
			if {![string equal $serverAddress $urlibServerAddress] && ![string equal www.$serverAddress $urlibServerAddress]} {
# the current server is not the URLib server
# >>> try in the scope of all sites from the URLib server (urlib.net)
				set command [list list ReturnURLPropertyList $criterionList]
# ReturnURLPropertyList (from the URLib site)
# MULTIPLE SUBMIT
				set scenario 0	;# scenario 1 doesn't let enought time for the query to be processed
# puts [list MultipleExecute [list $urlibServerAddress] $command $scenario]
# for testing: http://gjfb.home:1905/J8LNKB5R7W/3NAGJMS
#				set urlPropertyList [MultipleExecute [list {gjfb.home 19050}] $command $scenario]	;# for testing
				set urlPropertyList [MultipleExecute [list $urlibServerAddress] $command $scenario]
			}
		}
	}
# puts --$urlPropertyList--<BR>
# puts [join $urlPropertyList]<BR>
#	return $urlPropertyList
	return [join $urlPropertyList]
}

# ReturnURLPropertyList2 - end
# ----------------------------------------------------------------------
# ReturnURLPropertyList
# was constructed from FindSite
# called by ReturnURLPropertyList2 only

# ReturnURLPropertyList tries in the scope of the sites defined in
# the @siteList.txt file of the requiredmirror
# (empty requiredmirror turns to be the default local bibliographic mirror loBiMiRep)
# requiredmirror is defined and used mainly in CreateBriefEntry

# The ibi given in criterionList
# is searched within the scope of the local bibliographic mirror
# (unless the QUERY_STRING specifies another mirror (mirror=xxxx)).

# When the search results in more than one site, then the address
# of the site containing the official version is returned.
# If the official version is not encountered, then the most recent
# version (based on the metadata last update) is returned.

# criterionList is produced in ResolveIBI
# returns empty or a list of url properties of the unique repository satisfying the criterion list
# the returned list of url properties turns to be the ResolveIBI output

# extendedSearchFlag value is 0 (default) or 1 - 1 means to extend the search to Federated Archives
# extendedSearchFlag is set in BuildReturnPathArray (see get.tcl) and used in FindURLPropertyList2

proc ReturnURLPropertyList {criterionList {extendedSearchFlag 0}} {
	global env	;# for cgi script
	global environmentArray		;# for non cgi script - when executing UpdateArchivingPolicy in utilities2.tcl or CreateFullBibINPEEntry
##	global serverAddress	;# for non cgi script
#	global serverAddressWithIP	;# for non cgi script
	global printFlag	;# set in Get and Get- only

if $extendedSearchFlag {
# >>> to see the puts output go to the bottom of the source code page of the upper menu
#	puts [CallTrace]
}	
# set xxx $criterionList
# set xxx [CallTrace]
# Store xxx {C:/Users/Gerald Banon/tmp/bbb.txt} auto 0 a
 
if {[info exists printFlag] && $printFlag} {
	set clicks [clock clicks]
#	puts [CallTrace]<BR><BR>
 	puts >>>$clicks<BR>
	puts "ReturnURLPropertyList input: criterionList<BR>"
 	set list {}
	foreach {name value} $criterionList {
		lappend list [list $name $value]
	}
	puts [join [lsort -index 0 $list] <BR>]
	puts <BR><BR>
}

	array set criterionArray $criterionList
	
	ConditionalSet queryList criterionArray(parsedibiurl.querylist) {}
	
	if [info exists env(DOCUMENT_ROOT)] {
# the calling procedure is a cgi script
#		set serverAddressWithIP2 [list $env(IP_ADDR) $env(URLIB_PORT)]
		array set queryArray $queryList
		ConditionalSet currentRep queryArray(requiredmirror) $env(LOBIMIREP)	;# used by FindURLPropertyList
#		set ip $env(IP_ADDR)
	} else {
# the calling procedure is not a cgi script
# for example: CreateFullBibINPEEntry
#		set serverAddressWithIP2 $serverAddressWithIP
		set currentRep $environmentArray(localBibliographicMirrorRepository)	;# used by FindURLPropertyList
#		foreach ip [ReturnCommunicationAddress $serverAddressWithIP2] {break}
	}

# FINDURLPROPERTYLIST
# puts $criterionList
#	set searchResultList [FindURLPropertyList $criterionList2 $currentRep]	;# list of search results having the same ibi (original + copies)
#	set searchResultList [FindURLPropertyList $criterionList $currentRep]	;# list of search results having the same ibi (original + copies)	;# commented by GJFB on 2021-02-16
	set searchResultList [FindURLPropertyList $criterionList $currentRep $extendedSearchFlag]	;# list of search results having the same ibi (original + copies)	;# added by GJFB on 2021-02-16
# puts --$searchResultList--	;# >>> may contain an error message
# => --{archiveaddress gjfb.home contenttype Data ibi {rep iconet.com.br/banon/2001/02.10.22.55 ibip LK47B6W/E6H5HH} ibi.archiveservice {rep dpi.inpe.br/banon/1999/01.09.22.14} ibi.platformsoftware {rep dpi.inpe.br/banon/1998/08.02.08.56} state Original timestamp 2014-01-02T17:23:57Z url http://gjfb.home/col/iconet.com.br/banon/2001/02.10.22.55/doc/Readme.html urlkey 1426640661-5614626200274349}-- 
 	
	if [string equal {} $searchResultList] {return {{}}}

if {[info exists printFlag] && $printFlag} {
 	puts >>>$clicks<BR>
	puts "ReturnURLPropertyList: searchResultList - output of FindURLPropertyList<BR><BR>"
 	foreach searchResult $searchResultList {
 		set list {}
		foreach {name value} $searchResult {
			lappend list [list $name $value]
		}
		puts [join [lsort -index 0 $list] <BR>]
		puts <BR><BR>
	}
}

if 0 {
#	set urlPropertyList [SelectURLPropertyFromList $searchResultList $requiredSite $requiredItemStatus]
	set urlPropertyList [SelectURLPropertyFromList $searchResultList $requiredItemStatus]
# puts $urlPropertyList
	return [list $urlPropertyList]	;# list is needed otherwise empty elements are lost in the communication through multiple submit
} else {
	return $searchResultList	;# must be a list otherwise empty elements are lost in the communication through multiple submit
}

}

# ReturnURLPropertyList - end
# ----------------------------------------------------------------------
# MountQueryString
# used in ResolveIBI only

proc MountQueryString {queryList {backgroundLanguage {}} {cssFileURL {}}} {
	set queryStringList {}
	foreach {name value} $queryList {
		lappend queryStringList $name=$value
	}
	if ![string equal {} $cssFileURL] {
		lappend queryStringList cssfileurl=$cssFileURL
	}
	
# Add languagebutton
# specific to the URLib platform
# puts --$backgroundLanguage--
	if ![string equal {} $backgroundLanguage] {
		if {[lsearch $queryStringList languagebutton=$backgroundLanguage] == -1} {
			lappend queryStringList languagebutton=$backgroundLanguage	;# convert ibiurl.backgroundlanguage (if any) into languagebutton
		} else {
# languagebutton is already part of the IBI URL - nothing to do
		}
	}
# Add languagebutton - end

	set queryString [join $queryStringList &]
}

# MountQueryString - end
# ----------------------------------------------------------------------
# FindURLPropertyList
# used in ReturnURLPropertyList only

# ResolveIBI calls ReturnURLPropertyList2
# that calls ReturnURLPropertyList (locally or remotely)
# that calls FindURLPropertyList
# that calls FindURLPropertyList2
# that calls CreateResponseList
# that calls RemoteExecute
# that calls remotly GetURLPropertyList

# criterionList value is described in ResolveIBI

# extendedSearchFlag value is 0 (default) or 1 - 1 means to extend the search to Federated Archives
# extendedSearchFlag is set in BuildReturnPathArray (see get.tcl) and used in FindURLPropertyList2

if 0 {
# for testing
http://banon-pc3/J8LNKB5R7W/3CM2RT2
http://gjfb/iconet.com.br/banon/2001/05.25.16.44+(en)
}

proc FindURLPropertyList {criterionList mirror {extendedSearchFlag 0}} {
	global homePath
	global serverAddress
	global loCoInRep
	global printFlag	;# set in Get and Get- only
	global loBiMiRep	;# set in Get-, Get, Cover OR Copyright
	global serverAdministratorAddress	;# banon@dpi.inpe.br - set in CreateConfigurationFiles, Get-, Get or Cover
	
if $extendedSearchFlag {
# >>> to see the puts output go to the bottom of the source code page of the upper menu
#	puts [CallTrace]
}	
if 0 {	
	puts {Content-Type: text/html}
	puts {}
}

# puts [CallTrace]<BR><BR>
# puts $criterionList<BR><BR>

	array set criterionArray $criterionList
 
# part of the norm
	ConditionalSet clientIPAddress criterionArray(clientinformation.ipaddress) {}
	
	ConditionalSet filePath criterionArray(parsedibiurl.filepath) {}
	set ibi $criterionArray(parsedibiurl.ibi)
	ConditionalSet requiredItemStatus criterionArray(parsedibiurl.requireditemstatus) {}	;# not inserted in criterionList2
#	ConditionalSet requiredItemStatus criterionArray(parsedibiurl.requireditemstatus) {}
	ConditionalSet verbList criterionArray(parsedibiurl.verblist) {}
		
# not part of the norm
	ConditionalSet requiredBackgroundLanguage criterionArray(parsedibiurl.backgroundlanguage) {}
	ConditionalSet cssFileURL criterionArray(parsedibiurl.cssfileurl) {}
	ConditionalSet metadataFieldNameList criterionArray(parsedibiurl.metadatafieldnamelist) {}	
	ConditionalSet queryList criterionArray(parsedibiurl.querylist) {}	;# not inserted in criterionList2
	ConditionalSet requiredSite criterionArray(parsedibiurl.requiredsite) {}
	
# criterionList2 is for the Arquive

	set criterionList2 {}
# part of the norm
	if ![string equal {} $clientIPAddress] {lappend criterionList2 clientinformation.ipaddress $clientIPAddress}
	
	if ![string equal {} $filePath] {lappend criterionList2 parsedibiurl.filepath $filePath}
	lappend criterionList2 parsedibiurl.ibi $ibi
#	if {[lsearch $verbList GetFileList] != -1} {lappend criterionList2 parsedibiurl.verblist $verbList}
#	if ![string equal {} $requiredItemStatus] {lappend criterionList2 parsedibiurl.requireditemstatus $requiredItemStatus}
	if ![string equal {} $verbList] {lappend criterionList2 parsedibiurl.verblist $verbList}
		
# not part of the norm
	if ![string equal {} $requiredBackgroundLanguage] {lappend criterionList2 parsedibiurl.backgroundlanguage $requiredBackgroundLanguage}
	if ![string equal {} $cssFileURL] {lappend criterionList2 parsedibiurl.cssfileurl $cssFileURL}
	if ![string equal {} $metadataFieldNameList] {lappend criterionList2 parsedibiurl.metadatafieldnamelist $metadataFieldNameList}
#	if ![string equal {} $queryList] {lappend criterionList2 parsedibiurl.querylist $queryList}
	if ![string equal {} $requiredSite] {lappend criterionList2 parsedibiurl.requiredsite $requiredSite}
#	if {[lsearch $verbList GetMetadataFieldValue] != -1} {lappend criterionList2 parsedibiurl.verblist $verbList}
	
if {[info exists printFlag] && $printFlag} {
#	puts [CallTrace]<BR><BR>
	puts "FindURLPropertyList: criterionList2 - input of GetURLPropertyList<BR>"
 	set list {}
	foreach {name value} $criterionList2 {
		lappend list [list $name $value]
	}
	puts [join [lsort -index 0 $list] <BR>]
	puts <BR><BR>
}

# type
	set type [ConvertVerbListToType $verbList]
# puts --$type--

if 0 {
# old code (before the resolution norm (and the HTTP)) - still working
# using USP (URLibService protocol)
#	set scanAllArchivesFlag 1
# MULTIPLE SUBMIT
#	set command [list list GetURLPropertyList $criterionList]
	set command [list list GetURLPropertyList $criterionList2]
# puts $command<BR><BR>
	set siteList {}	;# use the content of col/$loCoInRep/doc/@siteList.txt - $mirror is not used but could be
	set listOfibiProperties [MultipleExecute $siteList $command 0 3]	;# scenario 0 - level 3 is for MultipleSubmit be able to reach currentRep
# returns a list of non-empty list - nothing found is {}
# puts -=-$listOfibiProperties-=-<BR><BR>	;# may content an error message
# puts [llength $listOfibiProperties]

	set urlPropertyList [SelectURLPropertyFromList $ibi $listOfibiProperties $requiredItemStatus $verbList]
	set listOfibiProperties [list $urlPropertyList]	;# list is needed otherwise empty elements are lost in the communication through multiple submit
# puts $listOfibiProperties
	return $listOfibiProperties

} else {
# new code (after the resolution norm (and the HTTP))
# using HTTP or USP

# scanAllArchivesFlag
## is one if the required item status is Original o Global Original
# is one if the required item status is Original
# http://gjfb/urlib.net/www/2015/03.16.02.25?ibiurl.requireditemstatus=Secure+Original
#	set scanAllArchivesFlag [regexp {Secure Original} $requiredItemStatus]
	set scanAllArchivesFlag [regexp {Original} $requiredItemStatus]	;# Original becomes Secure Original - Secure Original is still faster
# puts $scanAllArchivesFlag
	if {1 && ![string equal {} $requiredSite]} {
# with required site
		set optimizedListFlag 0
#		set siteProtocolList [list [list $requiredSite urlib.net/www/2014/03.16.03.40 USP]]	;# doesn't work
		set requiredSite2 [GetServerAddressFromHTTPHost $requiredSite]	;# added by GJFB on 2016-04-09 in order to accept HTTP host address - requiredSite2 must be a server address like {gjfb 800}
# J8LNKB5R7W/3FTRH3S is used in URL in FindURLPropertyList2 and serves for any Archive
#		set siteProtocolList [list [list $requiredSite J8LNKB5R7W/3FTRH3S USP]]	;# added by GJFB on 2014-12-30 - short cut - it is assumed that the required site criterion is only used with USP
		set siteProtocolList [list [list $requiredSite2 J8LNKB5R7W/3FTRH3S USP]]	;# added by GJFB on 2014-12-30 - short cut - it is assumed that the required site criterion is only used with USP
	} else {
# without required site
		if [file exists $homePath/col/$loCoInRep/auxdoc/xxx] {
			Load $homePath/col/$loCoInRep/auxdoc/xxx data binary
			set data [UnShift $data]
			set administratorCodedPassword [lindex $data end]
			if $scanAllArchivesFlag {
# list of all sites
				Load $homePath/col/$mirror/doc/@siteList.txt fileContent
				set optimizedListFlag 0
				foreach siteProtocolList [FormatSiteList $fileContent $serverAddress $loCoInRep {site loCoInRep2 archiveProtocol}] {break}	;# added by GJFB on 2021-02-16
			} else {
# optimized list of sites
#				set command [list list GetOptimizedListOfSites $ibi $mirror $administratorCodedPassword]
## MULTIPLE SUBMIT
## puts "MultipleExecute [list $serverAddress] $command 0"
#				foreach {optimizedListFlag siteProtocolList} [MultipleExecute [list $serverAddress] $command 0] {break}	;# scenario 0 - commented by GJFB on 2024-01-01 - MultipleExecute returns, for example, --1-- instead of --1 {{{gjfb 19050} dpi.inpe.br/banon/1999/01.09.22.14 USP}}--
# EXECUTE
				foreach {optimizedListFlag siteProtocolList} [Execute $serverAddress [list GetOptimizedListOfSites $ibi $mirror $administratorCodedPassword] 0] {break}	;# added by GJFB on 2024-01-01 - solve the opening of 'Example of robust hypertext and authentic data' (QABCDSTQQW/4AEFPDB) with two embedded figures
# puts --$siteProtocolList--
# => --{{gjfb 19050} dpi.inpe.br/banon/1999/01.09.22.14 USP}--
				if ![info exists siteProtocolList] {
#					set log "siteProtocolList doesn't exist - probably due to a lack of or a wrong administrator name, or a communication failure while accessing $serverAddress"
					set log "siteProtocolList doesn't exist - probably due to a wrong administrator name, or a communication failure while accessing $serverAddress"
if 1 {
# added by GJFB on 2023-03-16 - reguired to display the log, otherwise the Apache error 500 is displayed
			puts {Content-Type: text/html}
			puts {}
}
					error [StoreLog {alert} {FindURLPropertyList (1)} $log]	;# added by GJFB on 2016-08-03
				}
			}
		} else {
			regsub {@.*} $serverAdministratorAddress {} serverAdministrator	;# banon
#			set log "lack of administrator; to register $serverAdministrator (with e-mail address: $serverAdministratorAddress) as administrator point to:\nhttp://[ReturnHTTPHost $serverAddress]/col/$loBiMiRep/doc/mirror.cgi/Register?usertype=writeuser&languagebutton=en"	;# commented by GJFB on 2022-03-05 - doesn't help because requires open access
# puts [CallTrace]
			set log "lack of administrator - to see how to register $serverAdministrator (with e-mail address: $serverAdministratorAddress) as administrator, point to:\nhttp://urlib.net/ibi/8JMKD3MGP5W34M/3FU99GE"	;# added by GJFB on 2022-03-05 - Guia do administrador de Arquivo da rede IBI
if 1 {
# added by GJFB on 2023-03-16 - reguired to display the log, otherwise the Apache error 500 is displayed
			puts {Content-Type: text/html}
			puts {}
}
			error [StoreLog {alert} {FindURLPropertyList (2)} $log]	;# added by GJFB on 2018-05-15
		}
	}
# puts --$scanAllArchivesFlag--
# puts --$optimizedListFlag--
# puts --$siteProtocolList--
# => --{{gjfb 19050} dpi.inpe.br/banon/1999/01.09.22.14 USP}--
# => --{{gjfb.home 19050} J8LNKB5R7W/3FTRH3S USP}--
# set xxx --$siteProtocolList--
# Store xxx C:/tmp/bbb.txt auto 0 a

	set listOfibiProperties [FindURLPropertyList2 $criterionList2 $siteProtocolList $scanAllArchivesFlag $extendedSearchFlag]
# puts -+-$listOfibiProperties-+-

if 0 {
global env	
if ![info exists env(DOCUMENT_ROOT)] {
# the calling procedure is not a cgi script
 puts $ibi
 puts $criterionList2
 puts --$siteProtocolList--
 puts --$listOfibiProperties--
# Store listOfibiProperties C:/tmp/bbb.txt auto 0 a
# puts $optimizedListFlag
	}
}

# puts [list [string equal {} $listOfibiProperties] [expr !$scanAllArchivesFlag] $optimizedListFlag]
	if {[string equal {} $listOfibiProperties] && !$scanAllArchivesFlag && $optimizedListFlag} {
# optimized list of sites failed
# try again using the list of all sites
# list of all sites
		set optimizedListOfSitesFailedFlag 1
		Load $homePath/col/$mirror/doc/@siteList.txt fileContent
		foreach siteProtocolList [FormatSiteList $fileContent $serverAddress $loCoInRep {site loCoInRep2 archiveProtocol}] {break}	;# added by GJFB on 2021-02-16
		set listOfibiProperties [FindURLPropertyList2 $criterionList2 $siteProtocolList $scanAllArchivesFlag $extendedSearchFlag]
	} else {
		set optimizedListOfSitesFailedFlag 0
	}

#	return $listOfibiProperties
# listOfibiProperties may contain more than one ibi property responses, e.g., one refering to the original an another one to a copy
# example: http://gjfb/LK47B6W/E6H5HH?ibiurl.requireditemstatus=Original
# gjfb contains the original and gjfb:1906 a copy
# puts --$listOfibiProperties--
# puts --$verbList--
	set urlPropertyList [SelectURLPropertyFromList $ibi $listOfibiProperties $requiredItemStatus $verbList]
# puts --$urlPropertyList--	;# may contain an error message like: list element in braces followed by ">" instead of space

# puts [list [expr ![string equal {} $urlPropertyList]] [expr !$optimizedListFlag] [string equal {} $requiredSite]]
	if {![string equal {} $urlPropertyList] && !$optimizedListFlag && [string equal {} $requiredSite]} {
# Archive found and not part of the optimized list of Archive (site) and without required site
		array set urlPropertyArray $urlPropertyList
		set archiveServiceIBI [lindex $urlPropertyArray(ibi.archiveservice) end]
# SUBMIT
#		set message [Execute $serverAddress [list UpdateIBIToArquiveServiceArray $ibi $archiveServiceIBI $optimizedListOfSitesFailedFlag $administratorCodedPassword]]	;# commented by GJFB on 2018-05-27
#		set message [Execute $serverAddress [list UpdateIBIToArchiveServiceArray $ibi $archiveServiceIBI $optimizedListOfSitesFailedFlag $administratorCodedPassword]]	;# added by GJFB on 2018-05-27 -  commented by GJFB on 2025-12-21
		set message [Execute $serverAddress [list UpdateIBIToArchiveServiceArray $ibi $archiveServiceIBI $optimizedListOfSitesFailedFlag]]	;# added by GJFB on 2025-12-21
		
# puts $message	;# may contain an error message
	}

	set listOfibiProperties [list $urlPropertyList]	;# list is needed otherwise empty elements are lost in the communication through multiple submit
# puts $listOfibiProperties
	return $listOfibiProperties
}
}

# FindURLPropertyList - end
# ----------------------------------------------------------------------
# FindURLPropertyList2
# used in FindURLPropertyList only
# extendedSearchFlag value is 0 (default) or 1 - 1 means to extend the search to Federated Archives
# extendedSearchFlag is set in BuildReturnPathArray (see get.tcl) and used in this procedure

proc FindURLPropertyList2 {criterionList2 siteProtocolList scanAllArchivesFlag extendedSearchFlag} {
	global homePath	;# added by GJFB on 2021-02-16
	global loCoInRep	;# added by GJFB on 2021-02-16
	global printFlag	;# set in Get and Get- only
	
# return	;# testing "Tabela fornecendo os dados para o cálculo dos indicadores Físicos e Operacionais IPUB e IGPUB: ano de 2016" while there is no call to GetURLPropertyList
 
if 0 {	
	puts {Content-Type: text/html}
	puts {}
	puts --$siteProtocolList--
# => --{{gjfb 19050} dpi.inpe.br/banon/1999/01.09.22.14 USP}--
}

# puts [CallTrace]<BR><BR>
# puts $criterionList2<BR><BR>
# puts OK
	
	set queryString [ConvertListForArratyToQueryString [concat $criterionList2 {servicesubject urlRequest}]]
# puts $queryString
	set command [list GetURLPropertyList $criterionList2]	;#  used with USP only
# puts $command

	if $extendedSearchFlag {	;# added by GJFB on 2021-02-16 for Federated Archives that have agreed to share their collections
		if [file exists $homePath/col/$loCoInRep/auxdoc/siteStampXcodedPasswordArray.tcl] {
			source $homePath/col/$loCoInRep/auxdoc/siteStampXcodedPasswordArray.tcl	;# array set siteStampXcodedPasswordArray
			foreach siteStamp [array names siteStampXcodedPasswordArray] {
				lappend siteProtocolList "[lrange $siteStamp 0 1] USP"	;# add missing sites of the Federated Archives
			}
		}
	}
if $extendedSearchFlag {
# >>> to see (with USP archiveProtocol) the puts output go to the bottom of the source code page of the upper menu
#	puts --$siteProtocolList--
}	
	
	set messageList {}
# FOREACH
	foreach line $siteProtocolList {
# puts $line
# line:
# site loCoInRep2 archiveProtocol
		foreach {serverAddress2 loCoInRep2 archiveProtocol} $line {break}
# set archiveProtocol USP	;# faster
# set archiveProtocol HTTP
		if {[string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol]} {
# USP
			set site {} 	;# not used with USP
			set recipientAddress $serverAddress2
			set messageContent $command

		} else {
# HTTP
			set site [ReturnHTTPHost $serverAddress2]
			set recipientAddress $site/$loCoInRep2
			set messageContent $queryString
		}		
		lappend messageList [list $archiveProtocol $recipientAddress $messageContent]
	}

	set pID [CreateProcessID $command]	;# used with RemoteExecute only (USP)
	
	set ibi {}	;# ibi not used when agencyStructureFlag is 0
	set agencyStructureFlag 0
	return [CreateResponseList $ibi $messageList $agencyStructureFlag $scanAllArchivesFlag $pID]
}

# FindURLPropertyList2 - end
# ----------------------------------------------------------------------
# CreateListOfibiProperties
# callBack procedure
## used in FindURLPropertyList only with the HTTP protocol
# used in CreateResponseList only with the HTTP protocol

proc CreateListOfibiProperties {token} {
	upvar #0 $token state
	
	set ibiProperties [string trim [http::data $token]]
# puts --$ibiProperties--
	if $state(scanall) {
		set state(found) 2; return
	} else {
		if [string equal {} $ibiProperties] {
			set state(found) 2; return	;# continue
		} else {
			set state(found) 1; return	;# use the first found (non-empty)
		}
	}
}

# CreateListOfibiProperties - end
# ----------------------------------------------------------------------
# CreateListOfibiProperties2
# callBack procedure
## used in FindURLPropertyList only with the URLibService protocol (USP)
# used in CreateResponseList only with the URLibService protocol (USP)
## scanAllArchivesFlag value is 0 or 1
## l means to scan all Archives in case of secure original

proc CreateListOfibiProperties2 {token} {
	upvar #0 $token state
	
	set ibiProperties $state(data)	;# 1(data)
# puts --$ibiProperties--
	if $state(scanall) {
		set state(found) 2; return
	} else {
		if [string equal {{}} $ibiProperties] {
			set state(found) 2; return	;# continue
		} else {
			set state(found) 1; return	;# use the first found (non-empty)
		}
	}
}

# CreateListOfibiProperties2 - end
# ----------------------------------------------------------------------
# SelectURLPropertyFromList
## used in ReturnURLPropertyList only
# used in FindURLPropertyList only

proc SelectURLPropertyFromList {ibi searchResultList requiredItemStatus verbList} {
	global homePath
	
	global env	;# set in Gert- and Get - used to display warning message only
	global localSite	;# set in Gert- and Get - used to display warning message only
	upvar 4 languageRep1 languageRep1	;# set in ResolveIBI - used to display warning message only
	upvar 4 languageRep2 languageRep2	;# set in ResolveIBI - used to display warning message only
	upvar 4 contextLanguage contextLanguage	;# set in ResolveIBI - used to display warning message only
	upvar 4 displayWarningMessage displayWarningMessage	;# set in ResolveIBI - used to display warning message only
	
	if 0 {
# doesn't work with: http://gjfb/LK47B6W/E6H5HH+?ibiurl.requireditemstatus=Original

# Find the original (or deleted) among the copies
# the original may have be found after some copies
# requiredItemStatus is useful to access an original document for updating
#	if [string equal {Authenticated Original} $requiredItemStatus] #
	if [regexp {Original} $requiredItemStatus] {
		foreach urlPropertyList2 $searchResultList {
# puts --$urlPropertyList2--
			if [string equal {} $urlPropertyList2] {continue}	;# jump empty urlPropertyList2
			array set urlPropertyArray $urlPropertyList2
			if ![info exists urlPropertyArray(state)] {continue}
#			if [string equal $requiredItemStatus $urlPropertyArray(state)] #	;# commented by GJFB on 2015-02-16
			if [regexp {Original|Deleted} $urlPropertyArray(state)] {
# only an old original can be registered as deleted (not a copy) 
# puts >>>[list $urlPropertyList2]<BR>
				return $urlPropertyList2
			}
		}
		return	;# original not found
	}
# Find the original (or deleted) among the copies - end

}
if 0 {	
# firstPropertyNameList
# puts $searchResultList
	set firstPropertyNameList {timestamp state}	;# needed because the "array names" command doesn't produce a list in a specific order
	set searchResultList2 [MountListOfOrderedListOfValues $searchResultList $firstPropertyNameList]	;# needed because the "array names" command doesn't produce a list in a specific order
# puts >>>[list [SelectURLPropertyList $searchResultList2]]<BR>
	set list [lsort -command CompareStamp2 $searchResultList2]	;# sort with respect to metadatalastupdate (timestamp)
	set searchResult [lindex $list 0]	;# get the first - that is, the newest
	return [ConvertListToListForArray $searchResult]
} else {
# simplified code by GJFB on 2014-10-03 - the repository synchronization option is turning the above timestamp information processing obsolete
# puts --$searchResultList--
	if [string equal {} $searchResultList] {return}	;# nothing found
	if [regexp {Original} $requiredItemStatus] {
# original required
		set type [ConvertVerbListToType $verbList]	;# lastedition.translation(xx).metadata
		set originalFoundFlag 0	;# not found
		set withoutURLFlag 0	;# not found
		foreach urlPropertyList $searchResultList {
			array set urlPropertyArray $urlPropertyList
# Find the original (or deleted) among the copies
			if [info exists urlPropertyArray(url$type)]	{
# the url$type exists therefore state$type should exist
				if {!$originalFoundFlag && [regexp {Original|Deleted} $urlPropertyArray(state$type)]} {
# urlPropertyList2
					set urlPropertyList2 $urlPropertyList
					set originalFoundFlag 1	;# first found
				}
# Find the original (or deleted) among the copies - end
#				foreach {name value} $urlPropertyList #
						if [regexp {Original} $urlPropertyArray(state$type)] {
#							lappend archiveListArray($name) [list archiveaddress $urlPropertyArray(archiveaddress) ibi $urlPropertyArray(ibi) ibi.platformsoftware $urlPropertyArray(ibi.platformsoftware) $name $urlPropertyArray($name)]
							lappend archiveList [list archiveaddress $urlPropertyArray(archiveaddress) ibi $urlPropertyArray(ibi) ibi.platformsoftware $urlPropertyArray(ibi.platformsoftware)]
						}
#				#
			} else {
# http://gjfb.home/LK47B6W/E6H5HH+:?ibiurl.requireditemstatus=Original
# there is no URL at the first iteration
				if !$withoutURLFlag {
					set urlPropertyList2 $urlPropertyList
					set withoutURLFlag 1	;# first found
				}
			}
		}
		if {!$originalFoundFlag && !$withoutURLFlag} {
			return	;# original not found and without URL not found (with URL found) 
		}

# Detect unfair Archives
#		foreach name [array names archiveListArray] #
#			if {[llength $archiveListArray($name)] > 1} #
			if {[llength $archiveList] > 1} {
# there is at least one unfair site
# an investigation must be done
#				set log "\n\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] SelectURLPropertyFromList: there is at least one unfair Archive, archiveListArray($name) == $archiveListArray($name)\n"
#				Store log $homePath/@errorLog auto 0 a
				set log "there is at least one unfair Archive, archiveList =>\n[join $archiveList \n]"
				StoreLog {alert} {SelectURLPropertyFromList} $log
				if $displayWarningMessage {
					source $homePath/col/$languageRep2/doc/mirror/${contextLanguage}Cover.tcl
					set identifier $ibi
					catch {subst [set [list ${languageRep2}::unfair sites]]} output
					error $output
				}
			}
#		#
# Detect unfair Archives - end

	} else {
		foreach urlPropertyList2 $searchResultList {
			if ![string equal {} $urlPropertyList2] {break}	;# first non-empty urlPropertyList2
		}
	}
	return $urlPropertyList2
}
}

# SelectURLPropertyFromList - end
# ----------------------------------------------------------------------
# ConvertListForArratyToQueryString
# used in FindURLPropertyList

proc ConvertListForArratyToQueryString {listForArray} {
	set queryStringList {}
	foreach {name value} $listForArray {
# binary scan & H2 x; puts $x => 26
# binary scan = H2 x; puts $x => 3d
# binary scan ? H2 x; puts $x => 3f
# >>> HEXADECIMAL CONVERSION OF & and =
		regsub -all {&} $value {%26} value	;# added by GJFB on 2013-07-07	
		regsub -all {=} $value {%3d} value	;# added by GJFB on 2013-07-07 - year=2013_author_group.tcl -> year%3d2013_author_group.tcl	- otherwise decoding query string (split $env(QUERY_STRING) &=) doesn't work in GetIBIProperties (GetIBIProperties is obsolete in 2015)	
		regsub -all {\?} $value {%3f} value	;# added by GJFB on 2015-02-19 - http::geturl running in plutao doesn't accept more than one ? in URL
		lappend queryStringList $name=$value	;# adding =
	}
#	set queryString [join [lsort $queryStringList] &]	;# adding &
	set queryString [join $queryStringList &]	;# adding &
	regsub -all { } $queryString {%20} queryString
# puts $queryString
	return $queryString
}

# ConvertListForArratyToQueryString - end
# ----------------------------------------------------------------------
# ConvertListToListForArray
# used in SelectURLPropertyFromList only

# not used anymore
proc ConvertListToListForArray2 {itemList} {
	if [string equal {} $itemList] {return}
	foreach {itemNameList itemValueList} $itemList {break}
if 0 {
# old code
	set list2 {}
	foreach itemName $itemNameList itemValue $itemValueList {
		lappend list2 $itemName $itemValue
	}
	return $list2
} else {
# new code
	return [ConvertSimpleListToListForArray $itemNameList $itemValueList]
}
}

# ConvertListToListForArray - end
# ----------------------------------------------------------------------
# MountListOfOrderedListOfValues
# used by SelectURLPropertyFromList only
# mainList is a list of list for array
# mounts a list of list of names and a list of values in an appropriate order for further ranking of the output main list

# not used anymore
proc MountListOfOrderedListOfValues2 {mainList firstNameList} {
	set mainList2 {}
	foreach list2 $mainList {
		if [info exists array] {unset array}
		array set array $list2

# nameList
		set nameList $firstNameList
# Add other names
		foreach name [array names array] {
			if {[lsearch $firstNameList $name] == -1} {lappend nameList $name}
		}
# Add other names - end
		
		set valueList {}
		foreach name $nameList {
			lappend valueList $array($name)
		}
		lappend mainList2 [list $nameList $valueList]
	}
	return $mainList2
}

# MountListOfOrderedListOfValues - end
# ----------------------------------------------------------------------
# FindSite2
# is a special use of ResolveIBI
# FindSite has been removed
# contextLanguage is used by ResolveIBI to display warning messages in the appropriate language
# useURLibServerFlag value is 0 (default) or 1, 1 means to find directly through the URLib server (was used in SetAttributeTable)
# displayWarningMessage value is 0 or 1
# 1 means to display the "identifier not found" message
# in this case contextLanguage must be a valid language (ex: en or pt-BR)

# used ONLY in:
# dpi.inpe.br/banon-pc@1905/2005/02.19.00.40/doc/cgi/script.tcl: set siteToAddHeader [lindex [FindSite2 $wantedRepository] 0]
# iconet.com.br/banon/2003/04.18.13.10/doc/cgi/BibINPE.tcl: set siteRep [FindSite2 $nextEdition]
## cgi/copyright.tcl: set siteRep [FindSite2 $copyrightRep 1 $language]
# cgi/copyright.tcl: set siteRep [FindSite2 $copyrightRep]
# FindCopyrightRepositories: set siteRep [FindSite2 $copyrightRep 1 $language]
# cgi/cover.tcl: set siteRep [FindSite2 $currentRep $similarityFlag $language 0 $displayWarningMessage
# cgi/export.tcl: set siteContainingConversionProcedure [lindex [FindSite2 $wantedRepository] 0]
# cgi/submit.tcl: set siteRep [FindSite2 $wantedRepository]
# CreateTclPage : set siteRep [FindSite2 $scriptRepository]

# proc FindSite2 {ibi {similarityFlag 0} {contextLanguage {}} {metadataFlag 0} {useURLibServerFlag 0}} #
proc FindSite2 {ibi {similarityFlag 0} {contextLanguage {}} {useURLibServerFlag 0} {displayWarningMessage 0}} {
	global homePath

# puts $contextLanguage
	 	
	upvar languageRep1 languageRep1	;# used to display warning message only when FindSite2 is called from ResolveIBI (useful with Cover)
	upvar languageRep2 languageRep2	;# used to display warning message only when FindSite2 is called from ResolveIBI (useful with Cover)
	
	if $similarityFlag {
		set parsedIBIURL [list parsedibiurl.ibi $ibi parsedibiurl.verblist GetTranslation]
	} else {
#		if $metadataFlag #
		if 0 {
			set parsedIBIURL [list parsedibiurl.ibi $ibi parsedibiurl.verblist GetMetadataFieldValue parsedibiurl.metadatafieldnamelist {identifier nexthigherunit shorttitle}]	;# used in Get
		} else {
			set parsedIBIURL [list parsedibiurl.ibi $ibi]
		}
	}
# puts --$parsedIBIURL--
#	set displayWarningMessage [expr ![string equal {} $contextLanguage]]	;# commented by GJFB on 2015-07-30 - now is an argument of FindSite2
# RESOLVEIBI
	set urlPropertyList2 [ResolveIBI $parsedIBIURL $contextLanguage $displayWarningMessage {} $useURLibServerFlag]
# puts --$urlPropertyList2--	;# may contain an error message (<...>)
# resulting in the error:
# list element in braces followed by ">" instead of space
# while executing
# "array set urlPropertyArray $urlPropertyList2" (see below)
	if [regexp {^<(.*)>$} $urlPropertyList2 m errorMessage] {
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] FindSite2: [join $errorMessage \n]\n"
		puts $log
		Store log $homePath/@errorLog auto 0 a
		set urlPropertyList2 {}
	}

	if [string equal {} $urlPropertyList2] {
		set siteRep {}
	} else {
		array set urlPropertyArray $urlPropertyList2
#		ConditionalSet serverAddress urlPropertyArray(serveraddress) {}	;# needed with old code only - will not be necessary once all sites will be updated with a version posterior to 2013-08-18
		set site $urlPropertyArray(archiveaddress)
if 0 {
# old code
# http://gjfb/copyright.cgi/urlib.net/www/2014/03.25.23.20?languagebutton=pt-BR
# returns Copyright warning in english (when there is no repository with "Local Copyright" content type
		set documentServerAddress [GetServerAddressFromHTTPHost $urlPropertyArray(archiveaddress)]
		set repository [Execute $documentServerAddress [list FindRepositoryNameFromIBI $ibi]]
} else {
# new code by GJFB on 2014-09-22
		array set ibiArray $urlPropertyArray(ibi)
		set repository $ibiArray(rep)
}
		ConditionalSet metadataFieldList urlPropertyArray(metadatafieldlist) {}	;# needed by BuildReturnPathArray (see cgi/get.tcl)
#		set siteRep [list $urlPropertyArray(archiveaddress) $urlPropertyArray(repository) $serverAddress $metadataFieldList]	;# added by GJFB on 2013-08-15
#		set siteRep [list $urlPropertyArray(archiveaddress) $urlPropertyArray(repository) $metadataFieldList]	;# added by GJFB on 2014-04-03 - ReturnHTTPHost not needed (called in GetURLPropertyList)
		set siteRep [list $site $repository $metadataFieldList]	;# added by GJFB on 2014-04-09 - ReturnHTTPHost not needed (called in GetURLPropertyList)
	}
	return $siteRep
}

# FindSite2 - end
# ----------------------------------------------------------------------
# FindRepositoryFromIdentifier
# if siteList is empty, then
# @siteList.txt of the loBiMiRep is used

# not used anymore -  code is now in GetURLPropertyList
proc FindRepositoryFromIdentifier2 {identifier siteList} {
		set command [list list Select repository [list identifier, $identifier]]
# MULTIPLE SUBMIT
		return [lindex [MultipleExecute $siteList $command 1] 0]
}

# FindRepositoryFromIdentifier - end
# ----------------------------------------------------------------------
# FindSiteContainingTheOriginal
# ReturnSiteContainingTheOriginal is in utilitiesStart.tcl

proc FindSiteContainingTheOriginal {rep {ipFlag 1} {siteList {}}} {
		set command [list list ReturnSiteContainingTheOriginal $rep $ipFlag]
# MULTIPLE SUBMIT
# puts [MultipleExecute {} $command 1]
#		return [MultipleExecute {} $command 1]	;# use this line for texting clearing channel (click in statistics) - see also ReturnSiteContainingTheOriginal
#		return [lindex [MultipleExecute $siteList $command 1] 0]
		set siteContainingTheOriginalList [MultipleExecute $siteList $command 1]
		if {[llength $siteContainingTheOriginalList] > 1} {
# there is at least one unfair site
# an investigation must be done
			return {}
		}
		return [lindex $siteContainingTheOriginalList 0]
}

# FindSiteContainingTheOriginal - end
# ----------------------------------------------------------------------
# FindSiteContainingTheOriginal2
# if FindSiteContainingTheOriginal doesn't find the site then it tries in the scope of all sites
# from www.urlib.net
# used in Download
# useURLibServerFlag value is 0 (default) or 1, 1 means to find directly through the URLib server (used in SetAttributeTable)

proc FindSiteContainingTheOriginal2 {rep {ipFlag 1} {siteList {}} {useURLibServerFlag 0}} {
	global env

	if $useURLibServerFlag {
		set siteContainingTheOriginal {}
	} else {
		set siteContainingTheOriginal [FindSiteContainingTheOriginal $rep $ipFlag $siteList]
	}
# puts --$siteContainingTheOriginal--

	if [string equal {} $siteContainingTheOriginal] {
# not found in the local scope - use the www.urlib.net scope

# serverAddressWithIP
#		if [info exists env(IP_ADDR)] #	;# commented by GJFB on 2016-09-11 - env(IP_ADDR) may exist while env(IP_ADDR) may not
		if [info exists env(SERVER_NAME)] {
# the calling procedure is a cgi script
# Statistics is calling
			set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
#			set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
			set urlibServerAddress $env(URLIB_SERVER_ADDR)	;# www.urlib.net 800
#			set urlibServerAddressWithIP $env(URLIB_SERVER_ADDR)	;# ip and port of www.urlib.net
			set standaloneModeFlag $env(STANDALONE_MODE_FLAG)
		} else {
# the calling procedure is not a cgi script
# CountOneClick is calling
			global serverAddress
#			global serverAddressWithIP
			global urlibServerAddress	;# www.urlib.net 800
#			global urlibServerAddressWithIP	;# ip and port of www.urlib.net
			global standaloneModeFlag	;# set in LoadGlobalVariables
		}
#		set serverAddressWithIP [ReturnCommunicationAddress $serverAddressWithIP]

#		if ![string equal {{} 800} $urlibServerAddressWithIP] #
		if !$standaloneModeFlag {
# not in standalone mode
#			if ![string equal $serverAddressWithIP $urlibServerAddressWithIP] #
			if {![string equal $serverAddress $urlibServerAddress] && ![string equal www.$serverAddress $urlibServerAddress]} {
# the current server is not www.urlib.net
				set command [list list FindSiteContainingTheOriginal $rep $ipFlag]
# MULTIPLE SUBMIT
#				set siteContainingTheOriginal [MultipleExecute [list $urlibServerAddressWithIP] $command]
				set siteContainingTheOriginal [MultipleExecute [list $urlibServerAddress] $command]
			}
		}
	}
	return $siteContainingTheOriginal
}

# FindSiteContainingTheOriginal2 - end
# ----------------------------------------------------------------------
# GetURLibServerAddress
# used in:
# ServeLocalCollection (StartServer.tcl) - Firewall
# ReturnHostCollection (utilitiesStart.tcl)
#
# returns ip:port (old usage)
# returns ip URLibPort

proc GetURLibServerAddress {{ipFlag 1}} {
## runs with post
#	global postEnvironmentArray
#	return [Compress $postEnvironmentArray(urlibServerAddress)]
	if $ipFlag {
		foreach {fullServerName ip} [ReturnFullServerNameIP urlib.net 0] {break}	;# 0 is to avoid possible firewalls
# fullServerName not used
		return [list $ip 800]
	} else {
		return {www.urlib.net 800}
	} 
}

# GetURLibServerAddress - end
# ----------------------------------------------------------------------
# GetURLibServiceSiteWithIP
# used in post only
# used to run in www.urlib.net only

# returns ip and urlib port of the site for downloading the URLibService last version
# this site must not be a virtual host
# example of @URLibServiceSiteWithIP.txt content:
# 150.163.2.14:1905
# 150.163.2.175:1905
# 150.163.2.176
# 150.163.34.239 (plutao)

proc GetURLibServiceSiteWithIP {} {
	global homePath
	
	Load $homePath/@URLibServiceSiteWithIP.txt fileContent
	
	return $fileContent
}

# GetURLibServiceSiteWithIP - end
# ----------------------------------------------------------------------
# ReturnFullServerNameIP
# example:
# ReturnFullServerNameIP banon-pc2
# => banon-pc2.dpi.inpe.br 150.163.2.174
# pingFlag value is 0 or 1
# 0 means to don't ping from unix - useful when trying to get the urlib server ip and there is a firewall in between (this was true when urlib.net was hosted at INPE)
# useful, now, when this script (ReturnFullServerNameIP) is run by urlib.net and the serverName is at 150.163, this is necessary because there exists a firewall in beetwen at INPE
# used in Get (get.tcl)

proc ReturnFullServerNameIP {serverName {pingFlag 1}} {
	global homePath
	global URLibServiceRepository
	global tcl_platform
	global serverAddress

# >>> under windows XP the correct domain name must be set in Start>Control Panel>Network Connections>Local Area Connection Properties>>General>Internet Protocol (TCP/IP)>Advanced>DNS>Append these DNS suffixes (in order)>Add
# puts --$serverName--
# => --vaio--
# => --gjfb--
	catch {exec nslookup -retry=2 -timeout=1 $serverName > $homePath/col/$URLibServiceRepository/auxdoc/nslookupMessage}
	
# Server:  sputnik.dpi.inpe.br
# Address:  150.163.2.4
#
# Name:    hermes.dpi.inpe.br
# Address:  150.163.2.14

# Server:         150.163.34.1
# Address:        150.163.34.1#53
#
# Non-authoritative answer:
# Name:   mtc-m19.sid.inpe.br
# Address: 150.163.34.242
	
# Server:  sputnik.dpi.inpe.br
# Address:  150.163.2.4
#
# Name:    banon-pc2.dpi.inpe.br
# Address:  150.163.2.174

# Server:  UnKnown
# Address:  192.168.1.1
#
# Name:    banon-pc3.dpi.inpe.br
# Address:  150.163.2.174

# Servidor:  187-100-246-253.dsl.telesp.net.br
# Address:  187.100.246.253
# 
# Nome:    gjfb
# Address:  92.242.140.67

# Servidor:  openrg.home
# Address:  fdf4:22ef:e281:1:feb0:c4ff:fed2:f70c
#
# Nome:    gjfb.home
# Addresses:  fdf4:22ef:e281:1:d21:46:a84:2faf
#	  fdf4:22ef:e281:1:a9e0:b9a2:af4b:e1ad
#	  192.168.1.35

# Server:         200.160.2.3
# Address:        200.160.2.3#53
# 
# Non-authoritative answer:
# Name:   urlib.net
# Address: 200.160.7.168


# exec nslookup -retry=2 -timeout=1 gjfb
# =>
# Servidor:  sputnik.dpi.inpe.br
# Address:  150.163.2.4
# 
# *** sputnik.dpi.inpe.br nÆo encontrou gjfb: Non-existent domain

# exec nslookup -retry=2 -timeout=1 gjfb
# Servidor:  UnKnown
# Address:  192.168.0.1
# 
# Nome:    gjfb
# Address:  192.168.15.47
# 
# NÆo ‚ resposta autoritativa:
#

# 2021-12-28
# exec nslookup -retry=2 -timeout=1
# Servidor Padrão:  UnKnown
# Address:  192.168.0.1

	Load $homePath/col/$URLibServiceRepository/auxdoc/nslookupMessage fileContent
# puts $fileContent
#	regsub -all {\n} $fileContent { } itemList	;# commented by GJFB on 2015-01-27 - fileContent is already a tcl list
	set itemList2 {}
#	foreach item $itemList #
	foreach item $fileContent {
#		if [regexp {\.\w|UnKnown} $item] {lappend itemList2 $item}	;# not an item like: Consider using the `dig' or `host' programs instead.  Run nslookup with - commented by GJFB on 2014-11-30
#		if [regexp "\\.\\w|UnKnown|$serverName" $item] {lappend itemList2 $item}	;# not an item like: Consider using the `dig' or `host' programs instead.  Run nslookup with - added by GJFB on 2014-11-30 - Name (Nome) might be without dot (example: gjfb)
		if [regexp "\\.\\w|\\:\\w|UnKnown|$serverName" $item] {lappend itemList2 $item}	;# not an item like: Consider using the `dig' or `host' programs instead.  Run nslookup with - added by GJFB on 2014-11-30 - Name (Nome) might be without dot (example: gjfb)  - added by GJFB on 2015-01-27 - \\:\\w is for IPv6
	}
#	if [regexp {Non-authoritative answer:} $fileContent] {
#		return [list {} {}]
#	}
# puts --$itemList2--
	set fullServerName [lindex $itemList2 2]
	set ip [lindex $itemList2 3]
# puts --$fullServerName--
# puts --$ip--
	if ![string equal {} $ip] {
		set ip [lindex $itemList2 end]	;# added by GJFB on 2015-01-27 - it is assumed that IPv4 is at the end of the "Addresses:"
	}
# puts $ip
#	if [string equal {} $ip] {
#		return [list {} {127.0.0.1}]
#	}

#	if {$pingFlag && $tcl_platform(platform) == "windows"} #	;# commented by GJFB on 2019-04-02
	if {$tcl_platform(platform) == "windows"} {	;# added by GJFB on 2019-04-02 - pingFlag should control ping from unix only
#		return [list {} {}]	;# added by GJFB on 2021-07-23 - LAN mode - nslookup might inform a wrong IP after a possible change of IP when using a LAN with repeaters - the right IP is found using ping in FindInternetAddress - commented by GJFB on 2021-10-07
		if {[info exists serverAddress] && [string equal [lindex $serverAddress 0] $serverName]} {return [list {} {}]}	;# added by GJFB on 2021-10-07 - empty result must be returned if only if ReturnFullServerNameIP is run by the proper serverName - if serverName is urlib.net and ReturnFullServerNameIP is run by gjfb then no empty result should be returned ortherwise standaloneModeFlag might be set to 1 when it should be 0
# old code below		
		if [regexp {^192.168|^169.254} $ip] {return [list {} {}]}	;# LAN mode - ip might be wrong after a possible change of IP when using a LAN with repeaters
		if ![file exists $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage] {
# the ping command below may be time consuming because it may wait for a time-out
			catch {exec ping -n 1 $ip > $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage}	;# an error may occur (child process exited abnormally), nevertheless, the pingMessage file is written
		}
		Load $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage fileContent
# puts $fileContent
		if [regexp {100%|could not} $fileContent] {return [list {} {}]}	;# 100% loss | Ping request could not find host out - improper ip - probably LAN mode
	}
	if {$pingFlag && $tcl_platform(platform) == "unix"} {
		if ![file exists $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage] {
			catch {exec ping -c 1 $ip > $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage}
		}
		Load $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage fileContent
		if [regexp {100%|could not} $fileContent] {
# try again
			catch {exec ping -c 1 $ip > $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage}
			Load $homePath/col/$URLibServiceRepository/auxdoc/pingIPMessage fileContent
			if [regexp {100%|could not} $fileContent] {return [list {} {}]}	;# 100% loss | Ping request could not find host out - improper ip - probably LAN mode
		}
	}
# puts [list $fullServerName $ip]
	return [list $fullServerName $ip]
}

# ReturnFullServerNameIP - end
# ----------------------------------------------------------------------
# FindParentList
# FindParentList is RECURSIVE

proc FindParentList {rep parentListName level} {
# runs with post
	global referenceTable
	global loCoInRep
	if [string equal $rep $loCoInRep] {return}	;# cannot follow all the virtual citations
	incr level
	upvar $level $parentListName parentList
	lappend parentList $rep
	set list [array names referenceTable $rep,*]
	regsub -all "$rep," $list {} repList
	foreach rep $repList {
		if {[lsearch -exact $parentList $rep] == -1} {
			FindParentList $rep $parentListName $level
		}
	}
}

# FindParentList - end
# ----------------------------------------------------------------------
# CreateCitedRepositoryList
# used in ComputeRepositoryList, FindCopyrightRepositories, and RepositoryMTime

proc CreateCitedRepositoryList {rep} {
# runs with post
	set repList {}
	FindParentList $rep repList 0
#	return [lrange $repList 1 end]
	set repList [lsort -unique $repList]	;# added by GJFB on 2010-0820 - parent of parent may already be parent, example dpi.inpe.br/banon/1999/05.03.22.11 with respect to dpi.inpe.br/banon/1998/08.02.08.56 (because of dpi.inpe.br/banon/1999/06.19.22.43)
	set i [lsearch $repList $rep]
	return [lreplace $repList $i $i]
}

# source ../auxdoc/.referenceTable.tcl
# set loCoInRep dpi.inpe.br/banon/1999/01.09.22.14
# set rep dpi.inpe.br/banon/1998/08.02.08.56
# set rep dpi.inpe.br/banon/1999/06.19.22.43
# set rep iconet.com.br/banon/2000/12.31.20.38
# set rep iconet.com.br/banon/2000/12.30.22.40
# set rep iconet.com.br/banon/2000/12.30.22.55
# set rep dpi.inpe.br/banon/1999/05.03.22.11
# set list [CreateCitedRepositoryList $rep]
# puts [join $list \n]
# puts [llength $list]

# CreateCitedRepositoryList - end
# ----------------------------------------------------------------------
# BannerScript

proc BannerScript {path} {
	return "
<SCRIPT LANGUAGE=JavaScript>
window.open(href=\"$path\",\"Window\",
\"width=660,height=70,screenX=0,screenY=500,scrollbars=no,directories=no,location=no,menubar=no,resizable=no,status=no,toolbar=no,dependent=yes\");
</SCRIPT>
	"
}

# BannerScript - end
# ----------------------------------------------------------------------
# GetWordOccurrenceList
# currentRep is used in MultipleSubmit
# wordListLength is the number of words to be returned
# the wordListLength value is an integer or the empty value
# if wordListLength is empty, then all the words are returned

proc GetWordOccurrenceList {currentRep wordListLength {siteList {}}} {
# runs with post, start and cgi-script
	global numberOfSatisfiedQueries		;# set in MultipleSubmit
	global env
	global homePath	;# used when not runnning a cgi-script
	global numberOfSites		;# set in MultipleSubmit
#	upvar environment environment ;# used in MultipleSubmit

	set log [clock format [clock seconds]]
	Store log $homePath/col/$currentRep/doc/@log auto 0 a
	
	if ![info exists homePath] {
		set homePath $env(DOCUMENT_ROOT)
	}
	global wordOccurrenceList	;# used in MultipleSubmit
	set query {list GetWordOccurrences}
# MULTIPLE SUBMIT
	set wordOccurrenceList {}
	MultipleSubmit {} $query wordOccurrenceList 0 $siteList
	if {[regsub -all {^<|>$} [join $wordOccurrenceList] {} message] == 2} {
		set message [join $message \n]
		Store message $homePath/col/$currentRep/doc/@log auto 0 a
		return
	}
	set x 0; after 1 {set x 1}; vwait x	;# nice procedure
# puts $numberOfSatisfiedQueries
# puts $numberOfSites
	set log "numberOfSites == $numberOfSites"
	Store log $homePath/col/$currentRep/doc/@log auto 0 a
	set log "numberOfSatisfiedQueries == $numberOfSatisfiedQueries"
	Store log $homePath/col/$currentRep/doc/@log auto 0 a
	if {$numberOfSites != 1} {
		if {$numberOfSatisfiedQueries == "$numberOfSites"} {
			set wordOccurrenceList [join $wordOccurrenceList]
			foreach {word occurrence} $wordOccurrenceList {
				if [info exists occurrenceTable($word)] {
# ADD occurence from other collections
					set occurrenceTable($word) [expr \
						$occurrenceTable($word) + $occurrence]
				} else {
					set occurrenceTable($word) $occurrence
				}
			}
			set x 0; after 1 {set x 1}; vwait x	;# nice procedure
			set wordList [array names occurrenceTable]
			set wordOccurrenceList {}
			foreach word $wordList {
				lappend wordOccurrenceList [list $word $occurrenceTable($word)]
			}
			set x 0; after 1 {set x 1}; vwait x	;# nice procedure
		} else {
			set message {warning: nothing has been done because numberOfSites != numberOfSatisfiedQueries}
			Store message $homePath/col/$currentRep/doc/@log auto 0 a
			return
		}		
	}
	set wordOccurrenceList2 {} 	;# added by GJFB on 2020-10-24 - for some reason wordOccurrenceList might be empty
	foreach item [lsort -command CompareOccurrence $wordOccurrenceList] {
		lappend wordOccurrenceList2 $item
	}
	set x 0; after 1 {set x 1}; vwait x	;# nice procedure
	if [string equal {} $wordListLength] {
		return $wordOccurrenceList2
	}
	return [lrange $wordOccurrenceList2 0 [expr $wordListLength - 1]]
}

# GetWordOccurrenceList - end
# ----------------------------------------------------------------------
# CompareOccurrence
# see also CompareOccurrence- in utilitiesMirror.tcl

proc CompareOccurrence2 {a b} {
# not used
	set a1 [lindex $a 1]
	set b1 [lindex $b 1]
	return [expr $a1>$b1?-1:1]
}

proc CompareOccurrence {a b} {
	set aFrequency [lindex $a 1]
	set bFrequency [lindex $b 1]
	if {$aFrequency < $bFrequency} {
		return 1
	} else {
		if {$aFrequency == $bFrequency} {
			return [string compare [lindex $a 0] [lindex $b 0]]
		}
		return -1
	}
}

# CompareOccurrence - end
# ----------------------------------------------------------------------
# ComputeFileSize

proc ComputeFileSize {filePath} {
	if [catch {set size [file size $filePath]}] {
# file not found
		set size 0
	}
	return [expr int(ceil($size / 1024.))]	;# KiB
}

# ComputeFileSize
# ----------------------------------------------------------------------
# GetConversionTable
# example:
# GetConversionTable $languageRep2 $language
# global field::conversionTable

proc GetConversionTable {languageRep language} {
	global env

	regsub {(\d{4}).} $env(SERVER_PORT) {\1} serverPort	;# 19051 -> 1905
	regsub {^443$} $serverPort {80} serverPort	;# 443 -> 80
# see also StartCommunication (cgi/mirrorfind-.tcl)
	set site $env(SERVER_NAME):$serverPort

	Source http://$site/col/$languageRep/doc/mirror/${language}FieldName.tcl

	return
}

# GetConversionTable - end
# ----------------------------------------------------------------------
# Source
# url value is the url of a tcl file
# used in GetConversionTable, Get, Submit and some tcl pages
# if varName is not empty and is a sourced variable,
# then this variable is turned visible within the scope
# calling the Source procedure
# tryInLocalCollectionFlag value is 0 or 1 default), 1 means to try sourcing in the local collection

proc Source {url {varName {}} {tryInLocalCollectionFlag 1}} {
	global homePath
	global tcl_platform

	if ![string equal {} $varName] {upvar $varName $varName}

	if [regexp {col/([^/]+/[^/]+/[^/]+/[^/]+)/doc/.*$} $url filePath repName] {
# Source http://mtc-m21b.sid.inpe.br/col/sid.inpe.br/mtc-m21b/2014/06.15.16.33/doc/@tclPage.txt thesisList
		
		if $tryInLocalCollectionFlag {		
# Try in the local collection
			if [info exists homePath] {
				if [file isdirectory $homePath/col/$repName] {
# repName exists in the local collection
				
#					SynchronizeRepository $repName	;# time consuming when sourcing displayControl.tcl
				
					if [file exists $homePath/$filePath] {
						if [string equal {year=2012_author_resumeid.tcl} [file tail $filePath]] {
#							return	;# for testing the consequences of a source problem only
						}			
						source $homePath/$filePath
# puts $url
						return
					}
				}
			}
# Try in the local collection - end
		}
		
		package require http	;# see online manual
		if {$tcl_platform(platform) == "windows"} {
			set flag [catch {http::geturl [ConvertURLToHexadecimal $url] -timeout 0} token]	;# added by GJFB on 2018-02-12 - when the HTTP server doesn't return because of a firewall (for example when the HTTP access to mtc-m16d.sid.inpe.br was blocked by INPE help-desk) http::geturl returns after a long time-out, with -timeout 0 argument it returns rapidly - usefull for Windows (not required for Linux - works with some Linux distribution only, ex: the one hosting gjfb0520.sid.inpe.br, but not with others like the one hosting mtc-m16d.sid.inpe.br)
		} else {
# unix
			set flag [catch {http::geturl [ConvertURLToHexadecimal $url]} token]
		}
#		if [catch {http::geturl [ConvertURLToHexadecimal $url]} token] #	;# commented by GJFB on 2018-02-12
		if $flag {	;# added by GJFB on 2018-02-12
# puts $token	;# runs with post
		} else {
# geturl returned
			if [string equal {404} [::http::ncode  $token]] {
# The requested URL /col/urlib.net/www/2012/10.03.22.58/doc/year=1956_group_intranet.tcl was not found on this server.
# nothing done
			} else {
# SOURCE
				if [catch {eval [http::data $token]}] {
# eval command failed
#					puts {Content-Type: text/html}
#					puts {}
					global errorInfo
					set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Source (1): eval command failed while evaluating:\n[http::data $token]\nwhile accessing: $url\n$errorInfo\n"
					puts $log
					Store log $homePath/@errorLog auto 0 a
# nothing done
				}
			}
			http::cleanup $token
		}
# puts [http::code $token]
	} elseif {[regexp {createpage.cgi/[^/]+/[^/]+/[^/]+/[^/]+/doc/} $url]} {
# Source http://mtc-m21b.sid.inpe.br/createpage.cgi/sid.inpe.br/mtc-m21b/2014/06.15.16.33/doc/tclPage.txt
# 1 redirection
		package require http	;# see online manual
		if [catch {http::geturl [ConvertURLToHexadecimal $url]} token] {
		} else {
# geturl returned		
# puts [http::code $token]
			if [regexp {302} [http::ncode $token]] {
# redirection (move)
				set data [http::data $token]
# <a href="http://mtc-m21b.sid.inpe.br:80/col/sid.inpe.br/mtc-m21b/2014/06.15.16.33/doc/@tclPage.txt">
				regexp {[hH][rR][eE][fF]="(https?://[^/]+/col/[^"]+)"} $data m redirectedURL	;# "
# puts $redirectedURL
				if [catch {http::geturl [ConvertURLToHexadecimal $redirectedURL]} token2] {
				} else {
# geturl returned		
# puts [http::code $token2]
					if [string equal {404} [::http::ncode  $token2]] {
# The requested URL was not found on this server.
# nothing done
					} else {
# SOURCE
						if [catch {eval [http::data $token2]}] {
# eval command failed
#							puts {Content-Type: text/html}
#							puts {}
							global errorInfo
							set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Source (2): eval command failed while evaluating:\n[http::data $token2]\nwhile accessing: $url\n$errorInfo\n"
							puts $log
							Store log $homePath/@errorLog auto 0 a
# nothing done
						}
					}
					http::cleanup $token2
				}
			}
			http::cleanup $token
		}
	} else {
# Source http://mtc-m21b.sid.inpe.br/sid.inpe.br/mtc-m21b/2014/06.15.16.33
# 2 redirections - not implemented
# nothing done
	}
}

# Source - end
# ----------------------------------------------------------------------
# StoreService
# flag values are 0 or 1
# 1 means to do a secure storage
# example of fileName: hostCollection

proc StoreService {varName rep fileName {flag 1} {level #0}} {
	global homePath
	upvar $level $varName var
	
	if $flag {
# runs with start and post
		set data [Shift $rep $var]
		Store data $homePath/col/$rep/service/$fileName binary 1
	} else {
 		Store var $homePath/col/$rep/service/$fileName
	}
}

# StoreService - end
# ----------------------------------------------------------------------
# LoadService
# if the content of the file called fileName was corrupted
# then the content of var is returned as an empty list and the procedure returns 1
# example of fileName: hostCollection
# flag values is 0 or 1
# 1 means the data are codified

proc LoadService {rep fileName varName {flag 1} {level #0}} {
	global homePath
	upvar $level $varName var
	if $flag {
		set var {}
		Load $homePath/col/$rep/service/$fileName data binary
		set data [UnShift $data]
		if {[lindex $data 0] != "$rep"} {
# Security issue
# service/visibility file may have been deleted or emptied
			if [string equal {visibility} $varName] {
				set var 1	;# hidden
				StoreService var $rep visibility 1 1
			}
# Security issue - end
			return 1	;# corrupted data
		}
		set var [lindex $data end]
	} else {
		Load $homePath/col/$rep/service/$fileName var
	}
	return 0
}

# LoadService - end
# ----------------------------------------------------------------------
# Shift

proc Shift {rep var} {
	regexp {.$} $rep shift
	binary scan [list $rep $var] c* varC
	set data {}
	set space 0
	set i 0
	foreach number $varC {
		if $space {
			lappend data [expr $number + $shift - $i - 70]
			incr i
		} else {
			lappend data [expr $number - 81]
			if {$number == 32} {set space 1}
		}
	}
	set data [concat $data $shift]
	return [binary format c* $data]
}

# Shift - end
# ----------------------------------------------------------------------
# UnShift

proc UnShift {data} {
	binary scan $data c* dataC
	set shift [lindex $dataC end]
	set dataC [lreplace $dataC end end]
	set data {}
	set space 0
	set i 0
	foreach number $dataC {
		if $space {
			lappend data [expr $number + 70 + $i - $shift]
			incr i
		} else {
			lappend data [expr $number + 81]
			if {$number == -49} {set space 1}
		}
	}
	return [binary format c* $data]
}

# UnShift - end
# ----------------------------------------------------------------------
# SetFont

proc SetFont {htmlContent} {
	upvar fontTag fontTag
	regsub -all {<TT>} $htmlContent {<FONT FACE="Courier New">} htmlContent
	regsub -all {</TT>} $htmlContent {</FONT>} htmlContent
	return $htmlContent
}

# SetFont - end
# ----------------------------------------------------------------------
# WaitQueue
# return not used (see utilitiesStart.tcl)
# id is for reverse engineering, example id == OpenSession
# var, example var == symmetricKey
# call example: WaitQueue DisplayDocContent {}

proc WaitQueue {{id {}} {var {}}} {
	global homePath

# set xxx --$var--
# Store xxx C:/tmp/bbb.txt auto 0 a
	set i 0 
#	while {[set flag [EnterQueue $id $var]]} #	;# commented by GJFB on 2013-02-17
	set waitingFlag	0	;# not waiting
	while {[EnterQueue $id $var]} {
		set waitingFlag	1	;# waiting
		set xWaitQueue 0; after 100 {set xWaitQueue 1}; vwait xWaitQueue
		incr i
		if {[string equal {MultipleSubmit} $id] && $i > 100} {
# wait just one second - added by GJFB on 2012-12-24 - ten seconds is enough to solve cross communication problem
			set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] WaitQueue: breaking while\n"
#			puts $log
			Store log $homePath/@errorLog auto 0 a
			break
		}
	}
	if $waitingFlag {
# inform where waiting occurs
#		StoreLog {notice} {WaitQueue} [CallTrace]	;# commented by GJFB on 2018-06-28 (see CallTrace)
		set shortenFlag [string equal {OpenSession} $id]
		StoreLog {notice} {WaitQueue} [CallTrace $shortenFlag]	;# added by GJFB on 2018-06-28 (see CallTrace)
	}
}

# WaitQueue - end
# ----------------------------------------------------------------------
# WaitQueue2
# secure version of WaitQueue
## used in MultipleSubmit only
## tested but not used any more (see MultipleSubmit)
# used in Script (see iconet.com.br/banon/2007/01.01.16.00 or iconet.com.br/banon/2007/01.07.13.17)
# call example: WaitQueue2 DisplayDocContent {} xxx

proc WaitQueue2 {id var administratorCodedPassword} {
	global homePath

	set message [CheckAdministratorPassword administrator $administratorCodedPassword]
	if ![string equal {} $message] {return}	;# unfair call - do nothing
	
	WaitQueue $id $var	
}

# WaitQueue2 - end
# ----------------------------------------------------------------------
# EnterQueue
# Used by Submit (see Submit.tcl) and DDOK
# Used by CountOneClick
# Used by Run-ir
# Used by CaptureRepository
# Used by StoreRepository - (StoreRepository is not used any more)
# Used by PerformCheck
# Used by Dialog
# Used by DDDialog
# Used by CreateMirror (Inquiry)
## id is just to trace the running process
# var values are:
# {} -> insertionOn-
# inquiry -> insertionOn-inquiry
# deletedRecord -> insertionOn-deletedRecord (used by CheckMetadataConsistency)
# repositoryname -> insertionOn-repositoryname (used by CountOneClick)
# authentication -> insertionOn-authentication (used by SPOK and StorePassword2)
# randomNumber -> insertionOn-randomNumber (used by OpenSession}
# opensession -> insertionOn-opensession (used by OpenSession}
# closesession -> insertionOn-closesession (used by CloseSession}
# codedPassword is the coded password for the login: administrator - not used

proc EnterQueue {id {var {}} {codedPassword {}}} {
	global env
	global homePath
	global URLibServiceRepository

# set xxx 1-$id
# Store xxx C:/Users/gerald.banon/tmp/bbb auto 0 a 
	set var insertionOn-$var
	regsub -all {/} $var {=} var
# puts --$var--
# => --insertionOn-randomNumber--
# => --insertionOn-symmetricKey-- 
	if {[info exists env(DOCUMENT_ROOT)] && [info exists env(URLIB_SERVICE_REP)]} {
# a cgi script
		set fileName $env(DOCUMENT_ROOT)/col/$env(URLIB_SERVICE_REP)/auxdoc/$var
	} else {
# not a cgi script
##		if [string equal {} $var] #
#			if [CheckPassword administrator $codedPassword] {puts 2; return 2}	;# wrong password
##		#
#		set fileName ../auxdoc/$var
		set fileName $homePath/col/$URLibServiceRepository/auxdoc/$var
	}
# puts $fileName
	if [file exists $fileName] {
		return 1
	} else {
		if [catch {open $fileName w} fileId] {
# for example, permission denied
if 0 {
# commented by GJFB on 2023-10-14
			return 1
} else {
# added by GJFB on 2023-10-14 to let know about the error
			close $fileId
			file delete $fileName
			return -code error "
EnterQueue: $fileId
"
}
		}
#		set fileContent "[clock format [clock seconds] -format "%Y-%m-%d %H:%M:%S"] - $id"
		set fileContent [clock format [clock seconds] -format "%y:%m.%d.%H.%M.%S"]
		if ![string equal {} $id] {append fileContent " - $id"}	;# OpenSession
		if ![string equal {} $var] {append fileContent " - $var"}	;# added by GJFB on 2020-11-21 for allowing the identification of eventual failure for example while storing password (see StorePassword2)
		append fileContent \n[CallTrace]	;# added by GJFB on 2024-08-17 for reverse engineering
		puts $fileId $fileContent
# => 22:09.26.01.15.04 - OpenSession - insertionOn-randomNumber
		close $fileId
		return 0
	}
}

if 0 {
source utilities1.tcl
EnterQueue 123
}

# EnterQueue - end
# ----------------------------------------------------------------------
# LeaveQueue
# id not used in this procedure
# call example: LeaveQueue

proc LeaveQueue {{id {}} {var {}}} {
	global env
	global homePath
	global URLibServiceRepository
	
	set var insertionOn-$var
	regsub -all {/} $var {=} var
# set xxx --$var--
# Store xxx C:/tmp/bbb.txt auto 0 a 
	if {[info exists env(DOCUMENT_ROOT)] && [info exists env(URLIB_SERVICE_REP)]} {
# a script
		set fileName $env(DOCUMENT_ROOT)/col/$env(URLIB_SERVICE_REP)/auxdoc/$var
	} else {
# not a script
#		set fileName ../auxdoc/$var
		set fileName $homePath/col/$URLibServiceRepository/auxdoc/$var
	}
#	file delete $fileName
# the three lines below are useful to wait until the end of a read
	while {[catch {file delete $fileName}]} {
		set xLeaveQueue 0; after 100 {set xLeaveQueue 1}; vwait xLeaveQueue
	}
}

# not used
proc LeaveQueue2 {id {var {insertionOn}}} {
	global $var
	if [info exists $var] {unset $var}
# set xxx 2-$id
# Store xxx C:/Users/gerald.banon/tmp/bbb auto 0 a
}

# source C:/usuario/gerald/URLib/col/dpi.inpe.br/banon/1998/08.02.08.56/doc/utilities1.tcl
# LeaveQueue 123

# LeaveQueue - end
# ----------------------------------------------------------------------
# CallTrace
# Getting a trace of the Tcl call stack for debugging
# shortenFlag argument added by GJFB on 2018-06-28 is used in WaitQueue only

proc CallTrace {{shortenFlag 0}} {
	lappend list "call stack"
	for {set x [expr [info level] - 1]} {$x > 0} {incr x -1} {
		if $shortenFlag {
# added by GJFB on 2018-06-28 - some lines may be very long and should be shortened - ex: sessionContent may be very long in CheckListRecordArguments (see oai.tcl) - it may content a very long search result list - consequently some notice messages in @errorLog, as those produces by WaitQueue (when call by OpenSession) may be unnecessary very long
			set line [info level $x]
			set lineLength [string length $line]
			if {$lineLength > 200} {
				set shortLine [string range $line 0 99]...[string range $line end-99 end]
			} else {
				set shortLine $line 
			}
			lappend list "$x ($lineLength): $shortLine"
		} else {
			lappend list "$x: [info level $x]"
		}
	}
	lappend list "call stack - end"
	return [join $list \n]
}

# CallTrace - end
# ----------------------------------------------------------------------
# ProcessQuery
# Used only in mirror.tcl (SimpleForm, Form) and mirrorsearch.tcl
# in connection with dynamic help

proc ProcessQuery {} {
	global cgi
	
if 0 {
	if [info exists cgi(prefixquery)] {set cgi(query) [concat $cgi(prefixquery) $cgi(query)]}
	if [info exists cgi(suffixquery)] {set cgi(query) [concat $cgi(query) $cgi(suffixquery)]}
	if [info exists cgi(suffixquery2)] {set cgi(query) [concat $cgi(query) $cgi(suffixquery2)]}
	if [info exists cgi(suffixquery3)] {set cgi(query) [concat $cgi(query) $cgi(suffixquery3)]}
	regsub {^[^ ]* (and|and not|or) [^ ]*$|^[^ ]* (and|and not|or) | (and|and not|or) [^ ]*$}  $cgi(query) {} cgi(query)	;# to solve empty field problem in advanced search
	set cgi(query) [string trim $cgi(query)]
} else {
if 0 {
puts {Content-Type: text/html}
puts {}
}
# puts [array get cgi]
# puts --$cgi(query)--
	set query {}
	if [info exists cgi(prefixquery2)] {set query $cgi(prefixquery2)}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(prefixquery)] {set query [concat $query $cgi(prefixquery)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(query)] {set query [concat $query $cgi(query)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery)] {set query [concat $query $cgi(suffixquery)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery2)] {set query [concat $query $cgi(suffixquery2)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery3)] {set query [concat $query $cgi(suffixquery3)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery4)] {set query [concat $query $cgi(suffixquery4)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery5)] {set query [concat $query $cgi(suffixquery5)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery6)] {set query [concat $query $cgi(suffixquery6)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery7)] {set query [concat $query $cgi(suffixquery7)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery8)] {set query [concat $query $cgi(suffixquery8)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery9)] {set query [concat $query $cgi(suffixquery9)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery10)] {set query [concat $query $cgi(suffixquery10)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery11)] {set query [concat $query $cgi(suffixquery11)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery12)] {set query [concat $query $cgi(suffixquery12)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	if [info exists cgi(suffixquery13)] {set query [concat $query $cgi(suffixquery13)]}
	regsub { (and|and not|or) [^ ]+ (and|and not|or) } $query { \1 } query	;# to solve empty field problem in advanced search
	regsub {^[^ ]+ (and|and not|or) } $query {} query	;# to solve empty field problem in advanced search
#	regsub {^[^ ]* (and|and not|or) [^ ]*$|^[^ ]* (and|and not|or) | (and|and not|or) [^ ]*$}  $query {} query	;# to solve empty field problem in advanced search
	regsub { (and|and not|or) [^ ]*$}  $query {} query	;# to solve empty field problem in advanced search
# puts --$query--
	if [info exists cgi(startsearch)] {
# query comes form an advanced search (Advanced Search) - see DynamicHelp
		regsub {^[^ ]+$} $query {} query	;# added by GJFB on 2010-10-31 - drops the name of the second field, for example, ti (when the first two fields are empty)
	}
	set cgi(query) [string trim $query]
# puts --$cgi(query)--
}
	if [info exists cgi(referencetype)] {
		set cgi(referencetype) [string tolower $cgi(referencetype)]
		if ![string equal {} $cgi(referencetype)] {
			if [string equal {} $cgi(query)] {
				set cgi(query) [concat $cgi(query) ref $cgi(referencetype)]
			} else {
				set cgi(query) [concat $cgi(query) and ref $cgi(referencetype)]
			}
		}
	}
# puts --$cgi(query)--
}

# ProcessQuery - end
# ----------------------------------------------------------------------
# ReturnDistributedCollectionTest
# used in enAbout.html

proc ReturnDistributedCollectionTest {outputFormat {cellBackgroundColors {#EEEEEE #E3E3E3}}} {
	global homePath
	global currentRep	;# current mirror repository
	global env
#	global apacheFlag	;# needed by after
	global listOfActiveSites	;# set in MultipleSubmit
	global listOfInactiveSites	;# set in CreateMirror
	global numberOfNotAccessibleSites ;# used in CreateMirror

#	package require http

# serverAddress
	set localServerAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
	set localIP $env(IP_ADDR)
	set localServerAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]

if 0 {
# works but it's slower
	Load $homePath/col/$currentRep/doc/@siteList.txt fileContent
#	set fileContent [string trim $fileContent " \n"]
	set fileContent [string trim $fileContent]
	regsub -all "\n+" $fileContent "\n" fileContent
	set siteRepIpList [split $fileContent \n]
	set siteRepIpList [concat [list [list $localServerAddress {} $localIP]] $siteRepIpList]
	set numberOfSites2 [llength $siteRepIpList]
	set output {}
	set numberOfNotAccessibleSites 0
	foreach item $siteRepIpList {
# site
		set site [lindex $item 0]

		set serverAddress [ReturnCommunicationAddress $site]
		foreach {serverName urlibPort} $serverAddress {break}
		set ip [lindex $item 2]
		set serverAddressWithIP [list $ip $urlibPort]
		set httpHost [ReturnHTTPHost $serverAddress]

		set command [list list Identity $serverAddressWithIP]
# MULTIPLE SUBMIT
		set serverAddressWithIP2 [MultipleExecute [list $serverAddressWithIP] $command 0 1]	;# scenario 0
# urlibFlag
		set urlibFlag [string equal $serverAddressWithIP $serverAddressWithIP2]

#		set convertedURL [ConvertURLToHexadecimal http://$serverAddressWithIP/@serverRoot2]
#		set convertedURL [ConvertURLToHexadecimal http://$httpHost/@serverRoot2]
		set convertedURL [ConvertURLToHexadecimal http://$httpHost/index.html]
# apacheFlag
## time consuming because cancel doesn't cancel the execution of the delayed command
#		set apacheFlag 0
#		set id [after 1 set apacheFlag [ReturnApacheTest $convertedURL]]
#		set xw 0; after 100 set xw 1	;# 40 ms
#		vwait xw
#		after cancel $id
if 0 {
# time consuming because MultipleExecute doesn't return rapidely when the server address points to an apache server that is down
		set command [list list ReturnApacheTest $convertedURL]
# MULTIPLE SUBMIT
		set apacheFlag [MultipleExecute [list $localServerAddressWithIP] $command 1]
		if [string equal {} $apacheFlag] {set apacheFlag 0}
} else {
		if $urlibFlag {
#			set apacheFlag [expr ![catch {http::geturl $convertedURL}]]
			if [catch {http::geturl $convertedURL} token] {
				set apacheFlag 0
			} else {
				set fileContent [http::data $token]
				http::cleanup $token
				if [regexp -nocase $httpHost $fileContent] {
					set apacheFlag 1
				} else {
					set apacheFlag 0
				}
			}
		} else {
			set apacheFlag 0
		}
}
		if {!$urlibFlag || !$apacheFlag} {
# cellBackgroundColor
			set cellBackgroundColor [lindex $cellBackgroundColors [expr $numberOfNotAccessibleSites%2]]

			lappend output [subst $outputFormat]
			incr numberOfNotAccessibleSites
		}
	}
} else {
# in use
	Load $homePath/col/$currentRep/doc/@siteList.txt fileContent
#	set fileContent [string trim $fileContent " \n"]
	set fileContent [string trim $fileContent]
	regsub -all "\n+" $fileContent "\n" fileContent
	set siteRepIpList [split $fileContent \n]
	set siteRepIpList [concat [list [list $localServerAddress {} $localIP]] $siteRepIpList]
	set numberOfSites2 [llength $siteRepIpList]
	set output {}
	set numberOfNotAccessibleSites 0
	foreach item $listOfInactiveSites {
		set site [FindServerName $siteRepIpList $item]
		set urlibFlag 0
#		set apacheFlag 0
		set apacheFlag [ReturnServerTest $item apache]
# cellBackgroundColor
		set cellBackgroundColor [lindex $cellBackgroundColors [expr $numberOfNotAccessibleSites%2]]
		lappend output [subst $outputFormat]
		incr numberOfNotAccessibleSites
	}
	foreach item $listOfActiveSites {
		set urlibFlag 1
		set site [FindServerName $siteRepIpList $item]
if 0 {
# time consuming
		set httpHost [ReturnHTTPHost $site]
		set convertedURL [ConvertURLToHexadecimal http://$httpHost/index.html]

if 0 {
# 1
# may be time consuming as below (2)
		if [info exists apacheFlag] {unset apacheFlag}
		after 1 [list TestingApache $convertedURL $httpHost]
		set afterID [after 3000 set apacheFlag 0]
		vwait apacheFlag	;# wait at most 3000 ms
		after cancel $afterID
} else {
# 2
		if [catch {http::geturl $convertedURL} token] {
			set apacheFlag 0
		} else {
			set fileContent [http::data $token]
			http::cleanup $token
			if [regexp -nocase $httpHost $fileContent] {
				set apacheFlag 1
			} else {
				set apacheFlag 0
			}
		}
}
} else {
# in use
		set apacheFlag [ReturnServerTest $item apache]
}
		if !$apacheFlag {
			set cellBackgroundColor [lindex $cellBackgroundColors [expr $numberOfNotAccessibleSites%2]]
			lappend output [subst $outputFormat]	;# needs site, urlibFlag and apacheFlag
			incr numberOfNotAccessibleSites
		}
	}
}
	return $output
}

# ReturnDistributedCollectionTest - end
# ----------------------------------------------------------------------
# ReturnSiteInformation
# used in xxAbout.html only

proc ReturnSiteInformation {siteList siteInformationList outputFormat {cellBackgroundColors {#EEEEEE #E3E3E3}}} {
	array set siteInformationArray $siteInformationList
	set i 0
# puts $siteInformationList
	set output {}
	set ipPortList {}
	foreach site $siteList {
		if [info exists informationArray] {unset informationArray}
		array set informationArray $siteInformationArray($site)
		
		ConditionalSet currentIpPort informationArray(ipport) {}
		set lsearchResult [lsearch $ipPortList $currentIpPort]

		ConditionalSet serviceVersion informationArray(serviceversion) -
		ConditionalSet integrityAlert informationArray(integrityalert) &nbsp\;
		ConditionalSet insertionOn informationArray(insertionon) &nbsp\;
		ConditionalSet hourMinute informationArray(hourminute) -
		ConditionalSet numberOfProcessors informationArray(numberofprocessors) -
		if {$lsearchResult != -1} {set numberOfProcessors ($numberOfProcessors)}
		ConditionalSet cpuMHZ informationArray(cpumhz) -
		ConditionalSet ram informationArray(ram) -
		ConditionalSet ramUse informationArray(ramuse) -
		ConditionalSet cacheSize informationArray(cachesize) -
		ConditionalSet diskSpaceAvailable informationArray(diskspaceavailable) -
		if {$lsearchResult != -1} {set diskSpaceAvailable ($diskSpaceAvailable)}
		ConditionalSet used informationArray(used) -
		if {$lsearchResult != -1} {set used ($used)}
		ConditionalSet diskSpaceUse informationArray(diskspaceuse) -
		if {$lsearchResult != -1} {set diskSpaceUse ($diskSpaceUse)}
		ConditionalSet diskSpeed informationArray(diskspeed) -
		ConditionalSet numberOfReferences informationArray(numberofreferences) -
		ConditionalSet indexSize informationArray(indexsize) -
		
		set cellBackgroundColor [lindex $cellBackgroundColors [expr $i%2]]
		lappend output [subst $outputFormat]
# ipPortList
		if [info exists informationArray(ipport)] {
			lappend ipPortList $informationArray(ipport)
		}
		incr i
	}
	return $output
}

# ReturnSiteInformation - end
# ----------------------------------------------------------------------
# TestingApache
# used in ReturnServerTest only

proc TestingApache {convertedURL} {
	package require http
	if [catch {http::geturl $convertedURL -timeout 1800} token] {
		set apacheFlag 0
	} else {
		set fileContent [http::data $token]
		http::cleanup $token
		if [regexp {.} $fileContent] {
# fileContent is not empty
			set apacheFlag 1
		} else {
			set apacheFlag 0
		}
	}
	return $apacheFlag
}

# TestingApache - end
# ----------------------------------------------------------------------
# FindServerName
# 150.163.2.174 800 -> banon-pc2 800
# banon-pc2 800 -> banon-pc2 800

proc FindServerName {siteRepIpList serverAddress} {
	foreach {address urlibPort} $serverAddress {break}
	regsub -all {\.} $address {} address2
	if [regexp {^\d+$} $address2] {
# probably ip
# Find server name
		foreach item2 $siteRepIpList {
# ip2
			set ip2 [lindex $item2 2]
# site2
			set site2 [lindex $item2 0]
			set serverAddress2 [ReturnCommunicationAddress $site2]
			foreach {serverName2 urlibPort2} $serverAddress2 {break}
			if {[string equal $ip2 $address] && [string equal $urlibPort2 $urlibPort]} {
				set serverAddress2 [list $serverName2 $urlibPort2]
				break
			}
		}
# Find server name - end
	} else {
# probably not ip
		set serverAddress2 [list $address $urlibPort]
	}
	return $serverAddress2
}

# FindServerName - end
# ----------------------------------------------------------------------
# ReturnServerTest
# serverType value is urlib or apache
# returns 1 if the server is running and 0 otherwise

proc ReturnServerTest {serverAddress serverType} {
# runs with cgi scripts
	global serverFlag	;# needed by after

	foreach {address urlibPort} $serverAddress {break}
	if [string equal {apache} $serverType] {
# apache
#		regsub {.$} $urlibPort {} port	;# drop the last digit
		set httpHost [ReturnHTTPHost $serverAddress]
		set convertedURL [ConvertURLToHexadecimal http://$httpHost/index.html]
		return [TestingApache $convertedURL]
	} else {
# urlib
		set port $urlibPort
	}
# the code below doesn't work for apache (it may fail deciding that apache is running)
	if [catch {socket -async $address $port} s] {
		set serverFlag 0
	} else {
		if [info exists serverFlag] {unset serverFlag}
		fileevent $s writable {set serverFlag 1}
		set afterID [after 300 set serverFlag 0]
		vwait serverFlag	;# wait at most 300 ms
		after cancel $afterID
		close $s
	}
	return $serverFlag
}

# ReturnServerTest - end
# ----------------------------------------------------------------------
# ReturnApacheTest

# not used
proc ReturnApacheTest2 {convertedURL} {
	package require http
	set apacheFlag [expr ![catch {http::geturl $convertedURL} token]]
	http::cleanup $token
	return $apacheFlag
}

# ReturnApacheTest - end
# ----------------------------------------------------------------------
# ReturnTheMostRecentEntries
# used in enAbout.html ...
# Example: see enAbout.html (Latest acquisitions/updates)
# maximuNumberOfEntries is the maximum number of entries displayed
# if maximuNumberOfEntries is 0 then all the entries are displayed (in the case of a non empty search expression)
# sortedFieldName is the name of the field used in CreateOutput to sort the entries
# examples of sortedFieldName are pages (page is accepted), title, issuedate, metadatalastupdate, lastupdate...
# metadatalastupdate value (the default) leads to sort by time stamp
# examples of siteFieldName are site, referencetype or newspaper

proc ReturnTheMostRecentEntries {
	outputFormat maximuNumberOfEntries {localSearch 0}
	{cellBackgroundColors {#EEEEEE #E3E3E3}} {searchExpression {}} {sortedFieldName {metadatalastupdate}}
	{siteFieldName {site}}
} {
	global env
	global currentRep
	global language languageRep1 languageRep2
	global siteList	;# set within the slave interperter by CreateTclPage

if 0 {
	if $localSearch {
		set siteList $env(IP_ADDR):$env(SERVER_PORT)
	} else {
		set siteList {}
	}
}
	if ![info exists siteList] {set siteList {}}

	set dateFieldName $sortedFieldName
		
	if [string equal {} $searchExpression] {
# default mirror
		global cgi
		set cgi(sort) $sortedFieldName	;# used by CreateOutput
		upvar environment environment
		set maximumNumberOfReferences $maximuNumberOfEntries
		set query [list list GetMostRecentMetadataRep $currentRep $maximuNumberOfEntries 1 $sortedFieldName]
		set query2String {from=recent}
# puts $outputFormat
		return [CreateOutput $language $languageRep1 $languageRep2 $query $query2String Recent \
			../ 0 $maximumNumberOfReferences dateTitleSite 0 {} $localSearch {} $outputFormat \
			$cellBackgroundColors $siteList no yes 0 0 _blank $dateFieldName $siteFieldName]
	} else {
# used at INPE
		set accent no
		set case no
		set choice dateTitleSite
		set output [GetSearchResult $searchExpression $accent $case $choice \
		$sortedFieldName {} $localSearch {} $outputFormat $cellBackgroundColors \
		$siteList no 0 _blank $dateFieldName $siteFieldName Recent $maximuNumberOfEntries]
		return $output
	}
}

# ReturnTheMostRecentEntries - end
# ----------------------------------------------------------------------
# ReturnTheMostRecentEntries2
# used through socket by php
# example:
# ReturnTheMostRecentEntries2 banon-pc2:1905 {<tr BGCOLOR=$cellBackgroundColor><td NOWRAP ALIGN=CENTER>$day-$month-$year</td><td>&nbsp;<A HREF=http://$siteAddress/rep-/$repName TARGET=_blank>$title</A></td><td ALIGN=CENTER>$newspaper</td></tr>} 10 0 {#EFEFEF #CECECE} {} issuedate newspaper

proc ReturnTheMostRecentEntries2 {site outputFormat maximuNumberOfEntries {localSearch 0} {cellBackgroundColors {#EEEEEE #E3E3E3}} {searchExpression {}} {sortedFieldName {}} {siteFieldName {site}}} {
	global env
	global currentRep
	global language languageRep1 languageRep2

# env (add http environment)
	package require http	;# see online manual
	set token [http::geturl http://$site/getenv]
	array set env [http::data $token]
	http::cleanup $token

# currentRep
	set currentRep $env(LOBIMIREP)

# return [list ReturnTheMostRecentEntries $outputFormat $maximuNumberOfEntries $localSearch $cellBackgroundColors $searchExpression $sortedFieldName $siteFieldName]

# Find the language and the language repository
	foreach {language languageRep1 languageRep2 firstLanguageRep} [FindLanguage $currentRep] {break}
# Find the language and the language repository - end

	return [ReturnTheMostRecentEntries $outputFormat $maximuNumberOfEntries $localSearch $cellBackgroundColors $searchExpression $sortedFieldName $siteFieldName]
}

# ReturnTheMostRecentEntries2 - end
# ----------------------------------------------------------------------
# GetSearchResult
# used only by DisplaySearch and ReturnTheMostRecentEntries
# localSearch values are 0 or 1; 1 means to run just a local search (used to created local index - see StartService)
# numbering values are {} or {numbering prefix}; {} means to do no numbering
# outputFormat is used by briefTitleAuthor and dateTitleSite - default is for briefTitleAuthor
# linkType used by CreateBriefTitleAuthorEntry (see CreateBriefTitleAuthorEntry)
# targetValue is for example _blank, _self, ...
# dateFieldName is metadatalastupdate or issuedate (used by CreateDateTitleSite)
# siteFieldName is site or newspaper (used by CreateDateTitleSite)
# some option values are: Recent, Contributors, Search ...
# maximuNumberOfEntries is the maximum number of entries to be returned
# if maximuNumberOfEntries is 0 then all the entries are returned
# nameFormat value is short, familynamefirst or familynamelast (used by CreateBriefTitleAuthorEntry)
# nameSeparator value is a string like {; } or {<BR>} (used by CreateBriefTitleAuthorEntry)
# multipleSearch value is 0 (default) or 1
# 0 means that entrySearch is a search expression
# 1 means that entrySearch is a list of search expressions
# imageFlag value is 0 or 1; 1 means to display the thumbnail (if any)
# displayHiddenRecord value is 0 or 1; 1 means to display hidden records
# searchInputValue is a search expression - set in URL (used in mirrorHomePage.html, CreateMirror, LoopOverEntries, GetEntry and CreateBriefEntry)
# childIdentifier (ex: mirrorIdentifier) ia an IBIp or IBIn - set in MirrorSearch and used in CreateBriefEntry
# forceRecentFlag value is 0 (default) or 1 - 1 set in MirrorRecent is used to return to 'The most Recent' after clicking in Return (<) in the horizontal upper menu (see Get)
# forceHistoryBackFlag value is 0 or 1 (default) - 0 set in UpdateBody (called in MountHTMLPage) - added by GJFB on 2023-07-14 

proc GetSearchResult {
	searchExpression {accent no} {case no}
	{choice full} {sort key} {excludedFields {^$}}
	{localSearch 0} {numbering {}} {outputFormat 1}
	{cellBackgroundColors {#EEEEEE #E3E3E3}} {siteList {}}
	{page no} {linkType 0} {targetValue _blank}
	{dateFieldName metadatalastupdate} {siteFieldName site}
	{option Search} {maximuNumberOfEntries {0}}
	{nameFormat {short}} {nameSeparator {; }} {multipleSearch {0}}
	{imageFlag 1} {displayHiddenRecord 0} {searchInputValue {}}
	{childIdentifier {}} {forceRecentFlag 0} {forceHistoryBackFlag 1}
} {

#	global env
	global cgi
#	global currentRep	;# mirror
	global language languageRep1 languageRep2
	
	global homePath loCoInRep	;# added by GJFB on 2024-03-23 - set in DisplayDocContent

#	array set environment [array get env]	;# used in MultipleSubmit from CreateOutput

# puts {Content-Type: text/html}	;# needed when running a tcl page with safeflag == 0
# puts {}	;# needed when running a tcl page with safeflag == 0
# puts [CallTrace]
# => 
# 5: GetSearchResult {nexthigherunit J8LNKB5R7W/3EB9F8L and {textlanguage, pt-BR or not textlanguage, * and {col Voyage France and theme Albi}}} yes yes briefTitleAuthorMisc date.key {} 0 {} {place date} {} {{gjfb 19050} {marte.sid.inpe.br 800} {bibdigital.sid.inpe.br 800} {marte3.sid.inpe.br 804}} no 5 _top metadatalastupdate site Search 0 short <BR> 0 1 1 {\$searchInputValue} {\$childIdentifierList} {\$forceRecentFlag} 0
# 4: DisplaySearch {nexthigherunit J8LNKB5R7W/3EB9F8L and {textlanguage, pt-BR or not textlanguage, * and {col Voyage France and theme Albi}}} yes yes briefTitleAuthorMisc {($numberOfEntries)<BR>} {} 0 {} {{gjfb 19050} {marte.sid.inpe.br 800} {bibdigital.sid.inpe.br 800} {marte3.sid.inpe.br 804}} no 5 1 date.key {place date} _top dpi.inpe.br/banon/1999/06.19.17.00 short <BR> {} 0 1 1 {\$searchInputValue} {\$childIdentifierList} {\$forceRecentFlag} 0
# 3: UpdateBody urlib.net/www/2013/06.21.00.03 J8LNKB5R7W/3EB9F8L image dpi.inpe.br/banon/1999/06.19.17.00 {{col Voyage France and theme Albi} Albi {col Voyage France and theme Carcassonne} Carcassonne {col Voyage France and theme Lourdes} Lourdes {col Voyage France and theme Maison de vovó Michelle} {Maison de vovó Michelle} {col Voyage France and theme Montauban} Montauban {col Voyage France and theme Paris} Paris {col Voyage France and theme Toulouse} Toulouse} pt-BR {...} {sort date.key frozencontents yes hiddenrecord yes} 0
# 2: MountHTMLPage urlib.net/www/2013/06.21.00.03 {Archival Unit} {Voyage en France en 2012} {Archival Unit} File {Banon, G. J. F. & Banon, G. P. R.} 2012 J8LNKB5R7W/3EB9F8L dpi.inpe.br/banon/1999/06.19.17.00 {{col Voyage France} theme} 1 image {sort date.key frozencontents yes hiddenrecord yes} 1 {} {}
# 1: DisplayDocContent
# call stack - end
# puts [array get cgi]
	set cgi(continue) yes	;# to force continue
	set cgi(choice) $choice
	set cgi(sort) $sort	;# used by CreateOutput
	set cgi(accent) $accent
	set cgi(case) $case
#	set cgi(query) [list $searchExpression]
	set cgi(query) $searchExpression
	set cgi(multiplesearch) $multipleSearch	;# used in LoopOverEntries
	set cgi(imageflag) $imageFlag	;# used by CreateOutput

if 0 {
# commented by GJFB on 2024-03-23	
	if ![info exists cgi(codedpassword1)] {set cgi(codedpassword1) {}}
	if $displayHiddenRecord {
		set codedPassword1 $cgi(codedpassword1)
	} else {
		set codedPassword1 {}
	}
} else {
# added by GJFB on 2024-03-23 to be able to display hidden records in Archival Unit - for an example of use, see id 8JMKD3MGPCW/3KDBH7S
# puts $displayHiddenRecord
	if $displayHiddenRecord {
		ConditionalSet codedPassword1 cgi(codedpassword1) {}
		if {[string equal {} $codedPassword1] && [info exists loCoInRep]} {
# codedPassword1
			Load $homePath/col/$loCoInRep/auxdoc/xxx data binary
			set data [UnShift $data]
			set codedPassword1 [lindex $data end]
# puts --$codedPassword1--
		}
	} else {
		set codedPassword1 {}
	}
}

#	set query "list GetMetadataRepositories $currentRep 4 $cgi(query) $cgi(accent) $cgi(case) 1 metadatalastupdate repArray {} $sort $maximuNumberOfEntries"
#	set query [list list GetMetadataRepositories $currentRep 4 $cgi(query) $cgi(accent) $cgi(case) 1 metadatalastupdate repArray $cgi(codedpassword1) $sort $maximuNumberOfEntries]
#	set query [list list GetMetadataRepositories $currentRep 4 $cgi(query) $cgi(accent) $cgi(case) 1 metadatalastupdate repArray $cgi(codedpassword1) $sort $maximuNumberOfEntries {} $multipleSearch]
#	set query [list list GetMetadataRepositories {} 4 $cgi(query) $cgi(accent) $cgi(case) 1 metadatalastupdate repArray $cgi(codedpassword1) $sort $maximuNumberOfEntries {} $multipleSearch]
	set query [list list GetMetadataRepositories {} 4 $cgi(query) $cgi(accent) $cgi(case) 1 metadatalastupdate repArray $codedPassword1 $sort $maximuNumberOfEntries {} $multipleSearch]

	set query2String {query2=$cgi(query)&choice2=$cgi(choice)&accent2=$cgi(accent)&case2=$cgi(case)}
# puts [list CreateOutput $language $languageRep1 $languageRep2 $query $query2String $option {} 0 10 $cgi(choice) 0 $excludedFields $localSearch $numbering $outputFormat $cellBackgroundColors $siteList]
# set xxx [list CreateOutput $language $languageRep1 $languageRep2 $query $query2String $option {} 0 10 $cgi(choice) 0 $excludedFields $localSearch $numbering $outputFormat $cellBackgroundColors $siteList] 
# Store xxx C:/Users/gerald.banon/tmp/bbb auto 0 a
	set header 0
	set includeReturnAddress no

	return [CreateOutput \
	$language $languageRep1 $languageRep2 $query $query2String $option {} \
	0 $maximuNumberOfEntries $cgi(choice) $header \
	$excludedFields $localSearch $numbering $outputFormat \
	$cellBackgroundColors $siteList $page \
	$includeReturnAddress $linkType 0 \
	$targetValue $dateFieldName \
	$siteFieldName no {} \
	$nameFormat $nameSeparator $searchInputValue $childIdentifier \
	$forceRecentFlag $forceHistoryBackFlag]	;# forceHistoryBackFlag added by GJFB on 2023-07-14
}

# GetSearchResult - end
# ----------------------------------------------------------------------
# RunRemoteCGIScript
# the script is a CGI script that process a file in col/$repName/doc/$sourceFileName (local collection)
# and returns the file col/$scriptRepository/doc/tmp/$intermediateFileName (remote collection)
# scriptSite value is the http host (domain name and port of a site) having
# the repository: $scriptRepository
# scriptRepository value is the name of the repository constaining the script: $scriptName
# scriptName value is the name of the script (e.g., addHeader.cgi)
# to find the site use: set scriptSite [ReturnHTTPHost [lindex [FindSite2 $scriptRepository] 0]]
# repName value is the name of the repository containing the file to be processed
# sourceFileName value is the name (including extension) of the file to be processed
# queryString value is a string of the form name1=value1&name2=value2 containing the parameters to be passed to the CGI script
# this query string is concatenated to the string: fileurl=http://$localSite/col/$repName/doc/$sourceFileName
# RunRemoteCGIScript capture the file col/$scriptRepository/doc/tmp/$intermediateFileName (remote collection)
# and store it as col/$repName/doc/$destinationFileName (local collection)
# intermediateFileName value is the name (including extension) used by the CGI script to store the processed file in doc/tmp/ (remote collection)
# destinationFileName value is the name (including extension) of the processed file in the local collection
# if $sourceFileName == $destinationFileName then the processed file overwrites the original file
# if destinationFileName is empty then the CGI script result is returned via the return command
# in this case intermediateFileName can be anything

proc RunRemoteCGIScript {scriptSite scriptRepository scriptName repName \
	sourceFileName queryString {intermediateFileName {}} {destinationFileName {}}} {

	global localSite	;# set in Submit and Script (dpi.inpe.br/banon-pc@1905/2005/02.19.00.40)
	global homePath	;# set in Submit and Script (dpi.inpe.br/banon-pc@1905/2005/02.19.00.40)

	package require http

# Execute the cgi script
	regsub -all { } $sourceFileName {+} sourceFileName2
	set convertedURL [ConvertURLToHexadecimal http://$scriptSite/col/$scriptRepository/doc/$scriptName?fileurl=http://$localSite/col/$repName/doc/$sourceFileName2&$queryString]
# Store convertedURL C:/tmp/bbb.txt auto 0 a 
# Store convertedURL /mnt/dados1/URLib12e/bbb.txt auto 0 a 

	if [catch {http::geturl $convertedURL} token] {
# don't transfer - unkown remote host collection
# global errorInfo
# return "$token $errorInfo"
# set xxx "$token $errorInfo"
# Store xxx C:/tmp/bbb.txt auto 0 a 
# Store convertedURL C:/tmp/bbb.txt auto 0 a 
# => http://mtc-m12e.sid.inpe.br/col/dpi.inpe.br/banon-pc2@1905/2006/03.22.15.15/doc/addHeader.cgi?fileurl=http://mtc-m12e.sid.inpe.br/col/sid.inpe.br/mtc-m12e/2025/03.28.13.21/doc/v2.pdf&repname=sid.inpe.br/mtc-m12e/2025/03.28.13.21&header=%5Chref%7Bhttp://urlib.net/sid.inpe.br/mtc-m12e/2025/03.28.13.21%7D%7BINPE+ePrint:+sid.inpe.br/mtc-m12e/2025/03.28.13.21+v2++2025-04-17%7D
		return -code error "
RunRemoteCGIScript (1):
unknown host $scriptSite
"
	} else {
		if ![regexp {200 OK} [http::code $token]] {
# 1
			return -code error "
RunRemoteCGIScript (2):
url $convertedURL not found
--[http::code $token]--
"
		}
	}

	set message [http::data $token]
	http::cleanup $token
	if [regexp "^$scriptName:" $message] {
#	if ![string equal {} $message] #
		return -code error "
RunRemoteCGIScript (3):
cgi script $scriptName aborted
$message
"
	}
# Execute the cgi script - end

	if [string equal {} $destinationFileName] {
# Capture remote result
		if [catch {http::geturl $convertedURL} token] {
			return -code error "
RunRemoteCGIScript (4):
unknown host $scriptSite
"
		}
		if ![regexp {200 OK} [http::code $token]] {
# 2
			return -code error "
RunRemoteCGIScript (5):
url $convertedURL not found
--[http::code $token]--
"
		}
		return [http::data $token]
		http::cleanup $token
# Capture remote result - end
	} else {
# Capture the intermediate file
		set convertedURL [ConvertURLToHexadecimal http://$scriptSite/col/$scriptRepository/doc/tmp/$intermediateFileName]
# Store convertedURL C:/tmp/bbb auto 0 a 

		set fileId [open $homePath/col/$repName/doc/$destinationFileName w]
		if [catch {http::geturl $convertedURL -channel $fileId} token] {
# don't transfer - unkown remote host collection
# global errorInfo
# return "$token $errorInfo"
# set xxx "$token $errorInfo"
# Store xxx C:/Users/gerald.banon/tmp/bbb auto 0 a 
			return -code error "
RunRemoteCGIScript (6):
unknown host $scriptSite
"
		}
		if ![regexp {200 OK} [http::code $token]] {
# 3
			close $fileId
#			return -code error [list {url not found} $convertedURL [http::code $token]]
			return -code error "
RunRemoteCGIScript (7):
url $convertedURL not found
--[http::code $token]--
"
		}
		close $fileId
		http::cleanup $token
# Capture the intermediate file - end
	}
}

# RunRemoteCGIScript - end
# ----------------------------------------------------------------------
# FormatAuthorList
# used in brief output, cover page, etc.
# maximumNumberOfAuthors value is an integer (e.g., 3)
# if the number of authors is less or equal to maximumNumberOfAuthors then all the author names are displayed
# otherwise just the first author name is displayed followed by the expression "et al."
# if maximumNumberOfAuthors is empty then all author names are displayed

proc FormatAuthorList {authorList {separator &} {lastNameOnly 0} {capitalize 0} {lastSeparator {}} {maximumNumberOfAuthors {}}} {
	set authorList2 {}
	foreach author $authorList {
		regsub {,$} $author {} author
		if $lastNameOnly {regsub {,.*$} $author {} author}
		if $capitalize {set author [string toupper $author]}
		lappend authorList2 $author
	}
	set numberOfAuthors [llength $authorList2]
	if {![string equal {} $maximumNumberOfAuthors] && \
		$numberOfAuthors > $maximumNumberOfAuthors} {
		set comma {}
		if !$lastNameOnly {set comma ,}
		return "[lindex $authorList2 0]$comma et al."
	}
	set firstAuthors [lreplace $authorList2 end end]
	if [string equal {} $firstAuthors] {
		set authorList3 {}
	} else {
		if [regexp {,|;} $separator] {
			set authorList3 [list [join $firstAuthors "$separator "]]
		} else {
			set authorList3 [list [join $firstAuthors " $separator "]]
		}
	}
	set lastAuthor [lindex $authorList2 end]
	lappend authorList3 $lastAuthor
	if [string equal {} $lastSeparator] {set lastSeparator $separator}
	if [regexp {,|;} $lastSeparator] {
		return [join $authorList3 "$lastSeparator "]
	} else {
		return [join $authorList3 " $lastSeparator "]
	}
}

# puts [FormatAuthorList [FormatAuthorName [list {Boyer, Robert,} {Lusk, Ewing,} {McCune, William,} {Overbeek, Ross,} {Stickel, Mark,} {Wos, Laurence,}] {} familynamelast] {;}]
# => Robert Boyer; Ewing Lusk; William McCune; Ross Overbeek; Mark Stickel; Laurence Wos

# FormatAuthorList - end
# ----------------------------------------------------------------------
# FormatAuthorName
# authorList is a list of familynamefirst author names (see FormatName in utilities1.tcl)
# comma value is {,} or {}
# {} is used in the BibINPE format
# example:
# with comma == {,}
# FormatAuthorName returns: Banon, G. J. F.,
# with comma == {}
# FormatAuthorName returns: Banon, G. J. F.
# nameFormatList value is:
# familynamefirst
# familynamelast
# short
# {short familynamefirst} (same as short)
# {short familynamelast}

# firstNameAbbreviation value is 0 or 1; 1 means to abbreviate
# used with short only
# (used by GetAuthor and DisplaySearch)

proc FormatAuthorName {authorList {comma {,}} {nameFormatList {short}} {firstNameAbbreviation 1}} {
	if {[lsearch $nameFormatList {short}] != -1} {
# short
		set authorList [KeepInitials $authorList $comma $firstNameAbbreviation]
	}
	set authorList2 {}
	if {[lsearch $nameFormatList {familynamelast}] != -1} {
# familynamelast
		foreach author $authorList {
			regsub {,$} $author {} author2
			regsub {(.*), (.*)} $author2 {\2 \1} author2
			lappend authorList2 $author2$comma
		}
	} else {
# familynamefirst
		foreach author $authorList {
			regsub {,$} $author {} author2
			lappend authorList2 $author2$comma
		}
	}
	return $authorList2
}

# puts [FormatAuthorName [list {Banon, Gerald Jean Francis,}] , short]
# => {Banon, G. J. F.,}
# puts [FormatAuthorName [list {Boyer, Robert,} {Lusk, Ewing,} {McCune, William,} {Overbeek, Ross,} {Stickel, Mark,} {Wos, Laurence,}] {} familynamelast]
# => {Robert Boyer} {Ewing Lusk} {William McCune} {Ross Overbeek} {Mark Stickel} {Laurence Wos}

# FormatAuthorName - end
# ----------------------------------------------------------------------
# Replicate
# example: Replicate ab 2 => abab

proc Replicate {string time} {
	for {set i 1} {$i <= $time} {incr i} {
		append outputString $string
	}
	return $outputString
}

# Replicate - end
# ----------------------------------------------------------------------
# OpenSession
# used just by:
# CreateMirror (in cgi/mirror.tcl)
# Submit (in cgi/submit.tcl),
# Register (in cgi/register.tcl),
## GetURLPropertyList (in utilitiesMirror.tcl) and
# CheckListRecordArguments (in cgi/oai.tcl)
# adds sessions and, in the case sessionType value is randomNumber, removes old ones from sessionList file
# sessionList file is in col/dpi.inpe.br/banon/1998/08.02.08.56/auxdoc
# this file is used by:
# CheckSession called from CreateMirror (in cgi/mirror.tcl),
# CheckResumptionToken (in cgi/oai.tcl),
# CheckSession called from AcknowledgeArchive (in utilities1.tcl) and
# DecodeKey (in utilities1.tcl)
# each line in sessionList has the following format:
# a session ID and a session content
# where the session ID is of the form:
## "session openning time (in seconds)"-"random number"
# "session openning time (in milliseconds)"-"random number" or simply
# "session openning time (in milliseconds)"
# where sessionContent is username or
# a list containing searchResultList and deletedMetadataRepositoryList or
# the word urlkey or
# a symmetric key, an IP and a user name
# examples of session
# example 1: 1546716578962-13823731138545953 banon
# example 2: 1546723714374-4618184156378601 {oai_dc {{site rep-i} {site rep-i} ...} {{rep-i metadatalastupdate} {rep-i metadatalastupdate} ...}}
# example 3: 1546744117000-3525763031550069 urlkey
# example 4: 1547671175950 {98O7AuhIXZRBJvST4bPQN6nqY0jUkLowtGcEsxM1dlzpDKH52mayeg3fFVCirW 192.168.15.13 administrator} 
# and sessionType value is randomNumber, symmetricKey or asymmetricKey
# returns a session ID or a session ID and a symmetric key

proc OpenSession {sessionContent {sessionType {randomNumber}}} {
	global homePath
	global URLibServiceRepository

# puts [CallTrace]
	
	WaitQueue OpenSession $sessionType
#	WaitQueue OpenSession session
	if [string equal {randomNumber} $sessionType] {
# Keep the most recent randomNumber sessions
		set sessionList2 [GetSessionList $sessionType]
		set currentTime [clock seconds]
		set pastTime [expr $currentTime - (3600 * 24)]	;# 24 hours before
		set sessionList {}
		foreach session $sessionList2 {
#			regsub -- {-.*$} [lindex $session 0] {} seconds	;# session time - commented by GJFB on 2018-12-31
			regsub -- {-.*$} [lindex $session 0] {} sessionTime ;# added by GJFB on 2018-12-31 - now the session time is in milliseconds
			set seconds [string replace $sessionTime end-2 end]	;# drop the 3 last digits
if 0 {
# commented by GJFB on 2022-09-27 - the sessionList file might be corrupted and $seconds not be an integer - a catch is required	
			if {$seconds > $pastTime} {
				lappend sessionList $session
			}
# example of corrupted sessionList file:
# cat col/dpi.inpe.br/banon/1998/08.02.08.56/auxdoc/sessionList
# =>
# 1663736935545-2067258230452675 urlkey
# ...
# 1663823289550-271883573388203 urlkey
# lkey

# last line results in seconds == l (letter l) and an invalid bareword "l" - nevertheless this error is not catched as espected in ServeLocalCollection when GetURLPropertyList is run in the tcl server upon an ibi resolution query
# as a final result the session is not be closed (CloseSession is in AcknowledgeArchive) and the tcl server stops responding to new ibi resolution query
# in Linux the lsof command returns a CLOSE_WAIT line at each new ibi resolution query
# ex:
# lsof -w -n -i tcp:806
# COMMAND   PID       USER   FD   TYPE DEVICE SIZE/OFF NODE NAME
# tclsh   19777       root    3u  IPv4 232108      0t0  TCP *:806 (LISTEN)
# tclsh   19777       root    4u  IPv4 232567      0t0  TCP 150.163.34.248:806->150.163.34.248:49196 (CLOSE_WAIT)

# the only warning message is a notice from WaitQueue in the @errorLog file, ex:
# [2022:09.21.23.22.39] [notice] WaitQueue:
# call stack
# 4 (34): WaitQueue OpenSession randomNumber
# 3 (18): OpenSession urlkey
# 2 (512): GetURLPropertyList {clientinformation.ipaddress 114.119.158.34 parsedibiurl.ibi sid.inpe.br/mtc-m19/...ype repository rightsholder searchinputvalue shorttitle size targetfile title username versiontype}
# 1 (47): ServeLocalCollection sock4 150.163.34.248 38816
# call stack - end

} else {
# added by GJFB on 2022-09-27
			if ![catch {expr $seconds > $pastTime} m] {
				if $m {
					lappend sessionList $session
				}
			}
		}
}
# Keep the most recent randomNumber sessions - end
	} else {
		set sessionList [GetSessionList $sessionType]
	}

# Create a currentTime that is greater than the last session time
	regsub -- {-.*$} [lindex [lindex $sessionList end] 0] {} lastSessionTime
	set currentTime [clock milliseconds] ;# added by GJFB on 2018-12-31 - now the session time is in milliseconds
	while {[string compare $lastSessionTime $currentTime] != -1} {
# while is needed because of a possible computer clock small ajustment (that is a newer session may exist)
#		after 1000	;# 1 second delay - commented by GJFB on 2018-12-31
		after 100	;# delay of 100 milliseconds
#		set currentTime [clock seconds]	;# commented by GJFB on 2018-12-31
		set currentTime [clock milliseconds] ;# added by GJFB on 2018-12-31 - now the session time is in milliseconds
	}
# Create a currentTime that is greater than the last session time - end

# Add a new session
	switch -exact $sessionType randomNumber {
		regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} randomPassword	;# to reduce key violation - similar code in GetURLPropertyList
		set sessionID $currentTime-$randomPassword
		set openSessionReturn $sessionID
	} symmetricKey {
#		set publicSessionID $currentTime-[CreateSymmetricKey]
		set symmetricKey [CreateSymmetricKey]
		set sessionID $currentTime
		set openSessionReturn [list $currentTime $symmetricKey]
		set sessionContent [concat $symmetricKey $sessionContent]
	} asymmetricKey {
		set sessionID {}
		set openSessionReturn {}
	} default {
		set sessionID {}
		set openSessionReturn {}
	}

	lappend sessionList [list $sessionID $sessionContent]
# Add a new session - end

	switch -exact $sessionType randomNumber {
		set fileName sessionList
	} symmetricKey {
		set fileName symmetricKeySessionList
	} asymmetricKey {
		set fileName asymmetricKeySessionList
	} default {
		LeaveQueue {} $sessionType
		return
	}
	while {[catch {open $homePath/col/$URLibServiceRepository/auxdoc/$fileName w} fileId]} {
		set xProcess 0; after 100 {set xProcess 1}; vwait xProcess
	}
	puts $fileId [join $sessionList \n]
	close $fileId
	LeaveQueue {} $sessionType
#	LeaveQueue {} session
	return $openSessionReturn
}
if 0 {
# testing
	source utilities1.tcl
	source cgi/mirrorfind-.tcl	
	set homePath {C:/Users/Sony/URLib 2}
	set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
	OpenSession banon randomNumber
}

# OpenSession - end
# ----------------------------------------------------------------------
# SortRandomNumber

proc SortRandomNumber {{randomSeedRepository {}}} {
	global homePath
	global URLibServiceRepository
	
	if [string equal {} $randomSeedRepository] {
		set randomSeedRepository $URLibServiceRepository
	}
	if [file exists $homePath/col/$randomSeedRepository/auxdoc/randomSeed] {
		Load $homePath/col/$randomSeedRepository/auxdoc/randomSeed randomSeed
	} else {
		set randomSeed [pid]
	}
#	set randomSeed [expr ($randomSeed*9301 + 49297) % 233280]	;# commented by GJFB on 2024-09-18
	if [catch {set randomSeed [expr ($randomSeed*9301 + 49297) % 233280]}] {	;# catch added by GJFB on 2024-09-18 - randomSeed should be reset when, for some reason, it is corrupted or empty (otherwise displaying a bibliographic mirror produces a 500 error)
		set randomSeed [pid]
	}
	Store randomSeed $homePath/col/$randomSeedRepository/auxdoc/randomSeed
	return $randomSeed
}

if 0 {
# testing
	source utilities1.tcl
	source cgi/mirrorfind-.tcl	
	set homePath {C:/Users/geral/URLib 2}
	set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
	SortRandomNumber
}

# SortRandomNumber
# ----------------------------------------------------------------------
# CreateRandomPassword
# passwordLength range is 1 to 8

proc CreateRandomPassword {{passwordLength 8}} {
	regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} randomPassword
	set numberLetterList {
		0 a 11 b 12 c 13 d 14 e 15 f 16 g 17 h 18 i 19 j
		2a k 21 l 22 m 23 n 24 Y 25 p 26 q 27 r 28 s 29 t
		3a u 31 v 32 w 33 x 34 y 35 z 36 A 37 B 38 C 39 D
		4a E 41 F 42 G 43 H 44 I 45 J 46 K 47 L 48 M 49 N
		5a Z 51 P 52 Q 53 R 54 S 55 T 56 U 57 V 58 W 59 X
	}
	foreach {number letter} $numberLetterList {
		regsub -all $number $randomPassword $letter randomPassword
	}
	return [string range $randomPassword 0 [expr $passwordLength - 1]]
}

if 0 {
	set homePath "C:/Gerald/URLib 2"
	set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
	source "$homePath/col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl"
	puts [CreateRandomPassword]	;# => 7hi1a699X
}

# CreateRandomPassword - end
# ----------------------------------------------------------------------
# CheckSession
# returns 0 or 1
# 0 means that the session exists
# 1 means that the session doesn't exist

proc CheckSession {sessionID userName} {
	set sessionList [GetSessionList]
# puts $sessionList
# puts [list $sessionID $userName]
	return [expr [lsearch -exact $sessionList [list $sessionID $userName]] == -1]
}

# CheckSession - end
# ----------------------------------------------------------------------
# GetSessionList
# returns the list of sessions
# sessionList is in col/dpi.inpe.br/banon/1998/08.02.08.56/auxdoc

proc GetSessionList {{sessionType {randomNumber}}} {
	global homePath
	global URLibServiceRepository
	
	switch -exact $sessionType randomNumber {
		set fileName sessionList
	} symmetricKey {
		set fileName symmetricKeySessionList
	} asymmetricKey {
		set fileName asymmetricKeySessionList
	} default {
		return
	}
	
	if [file exists $homePath/col/$URLibServiceRepository/auxdoc/$fileName] {
		while {[catch {open $homePath/col/$URLibServiceRepository/auxdoc/$fileName r} fileId]} {
			set xCheck 0; after 100 {set xCheck 1}; vwait xCheck
		}
		set fileContent [string trim [read $fileId] \n]
		close $fileId	
		return [split $fileContent \n]
	} else {
		return
	}
}

# GetSessionList - end
# ----------------------------------------------------------------------
# CloseSession
## used in Register and AcknowledgeArchive only
# used in Register only

proc CloseSession {sessionID userName} {
	global homePath
	global URLibServiceRepository

	if ![file exists $homePath/col/$URLibServiceRepository/auxdoc/sessionList] {return}
#	while {[EnterQueue [pid] closesession]} {
#		set x 0; after 100 {set x 1}; vwait x
#	}
	
	WaitQueue CloseSession randomNumber	;# added by GJFB on 2013-09-11

	while {[catch {open $homePath/col/$URLibServiceRepository/auxdoc/sessionList r} fileId]} {
		set xclose 0; after 100 {set xclose 1}; vwait xclose
	}
	set fileContent [string trim [read $fileId] \n]
	close $fileId
	while {[catch {open $homePath/col/$URLibServiceRepository/auxdoc/sessionList w} fileId]} {
		set xclose 0; after 100 {set xclose 1}; vwait xclose
	}
	set list [split $fileContent \n]
# REMOVE
	if {[set i [lsearch -exact $list [list $sessionID $userName]]] != -1} {
		set fileContent [join [lreplace $list $i $i] \n]
	}
# REMOVE - end
	puts $fileId $fileContent
	close $fileId
	
	LeaveQueue {} randomNumber	;# added by GJFB on 2013-09-11
}

# CloseSession - end
# ----------------------------------------------------------------------
# ListDrop

proc ListDrop {listName pattern} {
	upvar $listName list
	set i [lsearch $list $pattern]	;# -glob matching
	set list [lreplace $list $i $i]
}

# ListDrop - end
# ----------------------------------------------------------------------
# CreateTclPage
# used only by CreateTclPageFile below
# thisRepository is useful in some tcl page, it contains the name of
# the repository that contains the tcl page (see CreateTclPageFile)
# filePath is the file path after doc and before $targetFile like 2015 in doc/2015/tclPage.txt (used by id J8LNKB5R7W/3HQN8GE)
# writeUserCodedPassword used by Load2

proc CreateTclPage {
	thisRepository fileContent language languageRep2 path targetFileAbsolutePath filePath writeUserCodedPassword
} {
	global timePeriod	;# set by TestForTclPageUpdate, used with enAbout.html, ...
	global numberOfSubstitutions	;# set by TestForTclPageUpdate
	global env
	global errorInfo
	global bgColor ;# used when updating the Local Collection Index (see localIndex.html)
	global numberOfSites	;# set in MultipleSubmit
	global numberOfActiveSites	;# set in ComputeFieldValueList (ComputeFieldValueList is invoked in DisplayMultipleSearch)
	global listOfInactiveSites	;# set in CreateOutput
	global currentRep	;# contains the current mirror repository
	global cgi
#	global numberOfEntries	;# used in the INPE clipping page
#	global mirrorRep	;# used in themeList.html
#	global submissionFormRepository	;# used in themeList.html
	global totalNumberOfEntries	;# set in DisplayMultipleSearch
	global sourceDisplayControl	;# used by start.html in some submission form repositories (e.g., Claiming papers)
	global col	;# used by start.html in some submission form repositories
	global mirrorHomePageRepository	;# used by start.html in some submission form repositories (e.g., Claiming papers)
	global submissionFormRep	;# used by start.html in some submission form repositories (e.g., Claiming papers)
	global submissionFormLanguageRep	;# set by CreatePage or Submit; used by Sending author notification
	global cssFileURL
# global below are used with safe interpreter
	global homePath
	global URLibServiceRepository
	global languageRep1
	global targetFile		;# set by CreatePage (see cgi/createpage.tcl) or ProcessTclPage (see cgi/submit.tcl)
	global targetFileDirname	;# set by CreatePage (see cgi/createpage.tcl) or ProcessTclPage (see cgi/submit.tcl) - used in CreateTclPage (needed when using DisplayNumberOfEntries)
	global targetFileRootName	;# set by CreatePage (see cgi/createpage.tcl) or ProcessTclPage (see cgi/submit.tcl) - used in CreateTclPage (needed when using DisplayNumberOfEntries)
	global targetFileExtension	;# set by CreatePage (see cgi/createpage.tcl) or ProcessTclPage (see cgi/submit.tcl) - used in CreateTclPage (needed when using DisplayNumberOfEntries)
	global targetFileType	;# set by CreatePage (see cgi/createpage.tcl) or ProcessTclPage (see cgi/submit.tcl)
	global storeTclPage	;# set by TestForTclPageUpdate
	global freezeSearchResult	;# set in a tcl page; used in CreateTclPageFile
	global errorLogPath	;# set in CreateTclPageFile
	global dirName		;# set in CreateTclPageFile
	global optionTable2	;# set in Submit (used when making table of contents)
	global tcl_platform
	global serverAddress ;# set by CreatePage or Submit
	global serverAddressWithIP ;# set by CreatePage or Submit, and used by SetFieldValue within the slave interpreter
	global loBiMiRep	;# used in FindMirrorRepositoryOfSubmissionFormRepository
	global conferenceAcronym	;# set by sourceDisplayControl in Submit
	global optionTable	;# set by sourceDisplayControl in Submit
	global defaultTable	;# set by sourceDisplayControl in CreatePage; used by Sending author notification
	global programCommitteeChairEMailAddressTable	;# set by sourceDisplayControl in CreatePage; used by Sending author notification
	global cameraReadySubmissionDeadlineTable	;# set by sourceDisplayControl in CreatePage; used by Sending author notification
	global conferenceHomePage 	;# set by sourceDisplayControl in CreatePage; used by Sending author notification
	global SMTPServer 	;# set by sourceDisplayControl in CreatePage; used by Sending author notification
	global numberOfReviewersPerWorkTable 	;# set by sourceDisplayControl in CreatePage or in Submit; used by Sending author notification
	global claimingDeadlineTable	;# set by sourceDisplayControl in CreatePage; used by Reviewer page for claiming papers
	global numberOfWorksPerReviewerTable	;# set by sourceDisplayControl in CreatePage; used by Reviewer page for claiming papers
	global alternateUserTable 	;# set by sourceDisplayControl in CreatePage; used by Sending author notification
	global clientServerAddressWithIP	;# set in Get only
	global progressKey	;# set in Get only
	global documentClassPath	;# set in CaptureDocumentClassFile and used in this procedure - added by GJFB on 2022-08-26

	upvar alternatePathWithoutExtension alternatePathWithoutExtension	;# added by GJFB on 2022-09-03 - alternatePathWithoutExtension is modified in this procedure and used in CreateTclPageFile
			
	set pt-BRMonthTable(01) janeiro
	set pt-BRMonthTable(02) fevereiro
	set pt-BRMonthTable(03) março
	set pt-BRMonthTable(04) abril
	set pt-BRMonthTable(05) maio
	set pt-BRMonthTable(06) junho
	set pt-BRMonthTable(07) julho
	set pt-BRMonthTable(08) agosto
	set pt-BRMonthTable(09) setembro
	set pt-BRMonthTable(10) Outubro
	set pt-BRMonthTable(11) novembro
	set pt-BRMonthTable(12) dezembro

	set pt-BRDayTable(0) Domingo
	set pt-BRDayTable(1) Segunda-feira
	set pt-BRDayTable(2) Terça-feira
	set pt-BRDayTable(3) Quarta-feira
	set pt-BRDayTable(4) Quinta-feira
	set pt-BRDayTable(5) Sexta-feira
	set pt-BRDayTable(6) Sábado

	set year [clock format [clock seconds] -format %Y]
	set pt-BRMonth [set pt-BRMonthTable([clock format [clock seconds] -format %m])]
	set pt-BRDay [set pt-BRDayTable([clock format [clock seconds] -format %w])]
	set day [clock format [clock seconds] -format %d]
	regsub {^0} $day {} day

# set xxx [CallTrace]
# set xxx OK2
# Store xxx C:/tmp/bbb.txt binary 0 a
if 0 {
# trying multipart/mixed - the second part doesn't work
 puts {Content-type: multipart/mixed; boundary="simple boundary"}
 puts {}
 puts {--simple boundary}
 puts {Content-Type: text/html}
 puts {}
 puts $currentRep
 puts "<!-- [string repeat a 5200] -->"
 puts {}
 puts {--simple boundary}
}
# cgiList
	set cgiList [array get cgi]
# puts $cgiList
# envList
	set envList [array get env]
# puts $envList
# optionTable2List
	set optionTable2List [array get optionTable2]
# numberOfReviewersPerWorkTableList
	set numberOfReviewersPerWorkTableList [array get numberOfReviewersPerWorkTable]
# conferenceAcronym
	if ![info exists conferenceAcronym] {set conferenceAcronym {}}
# optionTableList
	set optionTableList [array get optionTable]
# defaultTableList
	set defaultTableList [array get defaultTable]
# programCommitteeChairEMailAddressTableList
	set programCommitteeChairEMailAddressTableList [array get programCommitteeChairEMailAddressTable]
# cameraReadySubmissionDeadlineTableList
	set cameraReadySubmissionDeadlineTableList [array get cameraReadySubmissionDeadlineTable]
# conferenceHomePage
	if ![info exists conferenceHomePage] {set conferenceHomePage {}}
# SMTPServer
	if ![info exists SMTPServer] {set SMTPServer {}}
# numberOfReviewersPerWorkTableList
	set numberOfReviewersPerWorkTableList [array get numberOfReviewersPerWorkTable]
# claimingDeadlineTableList
	set claimingDeadlineTableList [array get claimingDeadlineTable]
# numberOfWorksPerReviewerTableList
	set numberOfWorksPerReviewerTableList [array get numberOfWorksPerReviewerTable]
# alternateUserTableList
	set alternateUserTableList [array get alternateUserTable]
# localSite
	set localSite [ReturnHTTPHost $serverAddress]	;# may be used in subst below (e.g., by start.txt in adm page)
# homePath (used in LoadService, StoreService and StorePassword)
	set homePath $env(DOCUMENT_ROOT)
# loCoInRep (used in StorePassword and index.html)
	set loCoInRep $env(LOCOINREP)
# loBiMiRep (used in target.html of iconet.com.br/banon/2001/04.28.19.50)
	set loBiMiRep $env(LOBIMIREP)
# codedPassword
	set allowedRepositoryList {}	;# no repositories are allowed
	set parentRepList [Execute $serverAddressWithIP [list GetCitedRepositoryList $thisRepository 1]]
	foreach rep $parentRepList {
		if [TestContentType $rep "Submission Form" $homePath] {
			set allowedRepositoryList $thisRepository	;# allows this repository (it is the child of a submission form repository), otherwise hidden submitted paper for conference would not be found when updating "Reviewer assignment and paper selection"
			break
		}
	}
	if {[lsearch $allowedRepositoryList $thisRepository] != -1} {
		Load $homePath/col/$loCoInRep/auxdoc/xxx data binary
		set data [UnShift $data]
		set codedPassword [lindex $data end]
	} else {
		set codedPassword {}
	}
# metadataRep
	set metadataRep [Execute $serverAddressWithIP [list FindMetadataRep $thisRepository]]
	SetFieldValue $serverAddress $metadataRep-0 {title author identifier parameterlist}

# window
	regsub -all {/} ${currentRep}___$metadataRep {__} window
	regsub -all {\.|@|-} $window {_} window
	set window ${window}___0

# Process LaTeX document
# there are two solutions to define the document class file (.cls) using the LaTeX command \documentclass{}
# 1. Defining the .cls file path (as usual in LaTeX), for example:
# \documentclass[brazilian,SemFolhaAprovacao]{tdiinpe}	% this option can be used without the @schedule.tcl file

# 2. Defining the .cls file URL - (this is unusual in LaTex), for example:
# \documentclass[brazilian,SemFolhaAprovacao]{http://urlib.net/iconet.com.br/banon/2008/03.25.01.19/tdiinpe}	% this URL option requires the @schedule.tcl file which is automatically created if it doesn't exist

# There are two alternate solutions
# 3. Solution 1. can be turned into an equivalent Solution 2. (without the need of the @schedule.tcl file) just by adding a commented LaTeX line as shown in the example below:
# \documentclass[brazilian,SemFolhaAprovacao]{tdiinpe}	% this option should be used without the @schedule.tcl file
# %\documentclass[brazilian,SemFolhaAprovacao]{http://urlib.net/iconet.com.br/banon/2008/03.25.01.19/tdiinpe}
# In this case, the @schedule.tcl file don't need to exist

# 4. In other words, Solution 2 can be implemented without the @schedule.tcl file just be commented the cls file URL line and adding the usual LaTeX \documentclass command as shown in the example below:
# %\documentclass[brazilian,SemFolhaAprovacao]{http://urlib.net/iconet.com.br/banon/2008/03.25.01.19/tdiinpe}
# \documentclass[brazilian,SemFolhaAprovacao]{tdiinpe}

# In Solution 3 and 4, the document class file (dpiinpe in the examples above) in the current repository is updated from the Web before the .tex compilation
# futhermore, no other commented \documentclass line with a different class file name (here different from tdiinpe) should be used before the commented line

	if [regexp -nocase {\.tex$} $path] {
		set serverName {urlib.net}
#		set serverName {banon-pc3.dpi.inpe.br}
		set backSlash {}
#		if {$numberOfSubstitutions == 1} {set backSlash {\\}}	;# commented by GJFB on 2022-08-19 - based on testing compilation of id J8LNKAN8PW/358PAHS
if 0 {
 puts {Content-Type: text/html}
 puts {}
# puts $path
# puts [CallTrace]
}
# => c:/users/geral/urlib 2/col/iconet.com.br/banon/2009/05.03.00.31/doc/testando@schedule/publicacao.tex
# puts $fileContent
# puts [regexp "(^|\[^%\])$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m x attribute documentClassURL documentClass]
#		if [regexp "(^|\[^%\])$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m x attribute documentClassURL documentClass] #
# puts $numberOfSubstitutions
# puts --$backSlash--
# puts [regexp "%?$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent]
#		if [regexp "%?$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m attribute documentClassURL documentClass] #	;# commented by GJFB on 2022-08-26
		if [regexp "%?$backSlash\\\\documentclass\[^\\{\]*\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m documentClassURL documentClass] {	;# added by GJFB on 2022-08-26 - simplifying
# the \documentclass argument is not a document class path but the URL of the document class
# puts [list $documentClassURL $documentClass]

# Capture the document class
			set redirectedURL [CaptureDocumentClassFile $thisRepository $documentClass $documentClassURL.cls]
# puts --$redirectedURL--
			if ![string equal {} $redirectedURL] {
				CaptureDocumentClassFile $thisRepository $documentClass $redirectedURL
			}
# Capture the document class - end

#			regsub {\[} $attribute {\[} attribute	;# commented by GJFB on 2022-08-26
#			regsub {\]} $attribute {\]} attribute	;# commented by GJFB on 2022-08-26
# puts "\\\\documentclass($attribute)\\{$documentClassURL\\}"		 
#			regsub "\\\\documentclass($attribute)\\{$documentClassURL\\}" $fileContent "\\documentclass\\1{$documentClass}" fileContent	;# documentClassURL -> documentClass - commented by GJFB on 2022-08-26 - doesn't work when the attribute contains parenthesis ()

			if [info exists documentClassPath] {
				if [regexp "%\[ \\t\]*\\\\documentclass(\[^\\{\]*)\\{$documentClassURL\\}" $fileContent] {	;# added by GJFB on 2022-09-03 - \1 is attribute
# Solution 3 or 4
					file delete $dirName/@schedule.tcl
					set fileList [glob -nocomplain $dirName/@[file rootname [file tail $targetFile]]*]
# puts $fileList
# => {c:/users/geral/urlib 2/col/iconet.com.br/banon/2009/05.03.00.31/doc/testando@schedule/@publicacao.aux} ... 
					if ![string equal {} $fileList] {eval file delete $fileList}
					set alternatePathWithoutExtension [file dirname $alternatePathWithoutExtension]/[regsub {^@} [file tail $alternatePathWithoutExtension] {}]	;# added by GJFB on 2022-09-03
				} else {
# Solution 2
					if [regsub "\\\\documentclass(\[^\\{\]*)\\{$documentClassURL\\}" $fileContent "\\documentclass\\1{$documentClassPath}" fileContent] {	;# documentClassURL -> documentClassPath # - added by GJFB on 2022-08-26 - \1 is attribute
# puts $dirName
# => c:/users/geral/urlib 2/col/iconet.com.br/banon/2009/05.03.00.31/doc/testando@schedule
						if ![file exists $dirName/@schedule.tcl] {
# added by GJFB on 2022-09-03 - @schedule.tcl must be created when using Solution 2
							set numberOfSubstitutions 1
							set storeTclPage 1
							StoreDefaultSchedule $thisRepository $path $numberOfSubstitutions $storeTclPage
							set alternatePathWithoutExtension [file dirname $alternatePathWithoutExtension]/@[file tail $alternatePathWithoutExtension]
						}
					}	;# }
				}	;# }

			} else {
#				regsub "\[^% \\t\]\\\\documentclass(\[^\\{\]*)\\{$documentClassURL\\}" $fileContent "\\documentclass\\1{$documentClass}" fileContent	;# documentClassURL -> documentClass # } - added by GJFB on 2022-08-26 - \1 is attribute - commented by GJFB on 2024-05-26 because the resulting string is \documentclass
				regsub "\[^% \\t\]\\\\documentclass(\[^\\{\]*)\\{$documentClassURL\\}" $fileContent "\\\\\\documentclass\\1{$documentClass}" fileContent	;# documentClassURL -> documentClass # } - added by GJFB on 2022-08-26 - \1 is attribute - added by GJFB on 2024-05-26 to preserve the string \\documentclass
			}
		}
		regsub -all {“} $fileContent {``} fileContent	;# this character is preserved with utf-8 encoding
		regsub -all {”} $fileContent {''} fileContent	;# this character is preserved with utf-8 encoding
#		regsub -all {\$} $fileContent {\$} fileContent	;# doesn't work
		regsub -all {–} $fileContent {--} fileContent	;# this character is preserved with utf-8 encoding
#		regsub -all {–} $fileContent {$-$} fileContent
		regsub -all {’} $fileContent {'} fileContent	;# this character is preserved with utf-8 encoding
# puts [regexp {(^\s*|\s*[^\\]|\n\s*|\n\s*[^\\])\\documentclass} $fileContent]		
		if [regexp {(^\s*|\s*[^\\]|\n\s*|\n\s*[^\\])\\documentclass} $fileContent] {return $fileContent}	;# don't do any substitution (when there is only one \ before the word documentclass at the beginning of a line) - contentFile is stored in CreateTclPageFile - added by JGFB in 2011-04-18
	}
# Process LaTeX document - end

#	if ![TestContentType $thisRepository {^Tcl Page$|^Index$|^CGI Script$|^Submission Form$} $homePath] {return $fileContent}	;# security issue (because of the .tex target file) - this is not so critical now because of the slave interp
	if [string equal 0 $numberOfSubstitutions] {return $fileContent}

	set mirrorRep [FindMirrorRepositoryOfSubmissionFormRepository $submissionFormRep]	;# used by Script (script.tcl - Meta form) and CreateTclPage only

# clientServerAddressWithIP
	if ![info exists clientServerAddressWithIP] {set clientServerAddressWithIP {}}
# progressKey
	if ![info exists progressKey] {set progressKey {}}

# set xxx "CreateTclPage: language = $language"
# Store xxx C:/tmp/bbb.txt binary 0 a

	set safeFlag [expr [clock scan "Mar 16, 2008"] < [file mtime $targetFileAbsolutePath]]	;# becomes safe after 2008-03-16 - added by GJFB on 2015-01-23 in order to allow working with a file path after doc and before $targetFile like 2015 in doc/2015/tclPage.txt
if 0 {
# display some error messages or puts command result for debugging
	set safeFlag 0
	puts {Content-Type: text/html}
	puts {}
} 
# set safeFlag 0	;# useful when the Store command must be added for debugging
# CREATE slave
	if $safeFlag {interp create -safe slave} else {interp create slave}
	foreach {bgColor background bgProperties fontTag fontTag2} [GetBg $languageRep1 $language] {break}
#	if [file exists $homePath/col/$thisRepository/auxdoc/@siteList.tcl] #
#		source $homePath/col/$thisRepository/auxdoc/@siteList.tcl	;# set siteList
#	# else #
		set siteList [ComputeSiteList $currentRep]	;# see utilities1.tcl
# =>
# plutao.dpi.inpe.br:80
# mtc-m05.sid.inpe.br:80
# mtc-m12.sid.inpe.br:80
# marte.dpi.inpe.br:80
# {marte2.dpi.inpe.br 802}		
#	#
if 0 {
 puts {Content-Type: text/html}
 puts {}
 puts $currentRep	;# mirror repository
 puts $siteList
} 

	set errorTrace 0	;# to avoid running Store in MultipleSubmit
	
	global applicationNameForReverseEngineering applicationRuningTime applicationFileName	;# for reverse engineering only - used in RemoteExecute
# thisIdentifier
	set thisIdentifier [FindIdentifierNameFromIBI $thisRepository]	;# added by GJFB on 2022-07-10
	set loCoInId [FindIdentifierNameFromIBI $loCoInRep]	;# added by GJFB on 2022-06-13
	LoadService $loCoInRep registrationPassword registrationPassword 1 1	;# added by GJFB on 2025-06-22 - used in urlib.net/www/2025/06.21.16.14

	interp alias slave Import {} Identity [list $currentRep $language $languageRep1 $languageRep2 $homePath $bgColor $background $bgProperties $fontTag $fontTag2 $siteList $cgiList $envList $targetFileDirname $targetFileRootName $targetFileExtension $targetFileType $storeTclPage $dirName $localSite $timePeriod $thisRepository $thisIdentifier $cssFileURL $serverAddress $serverAddressWithIP $metadataRep $title $author $identifier $parameterlist $codedPassword $optionTable2List $errorTrace $tcl_platform(os) $window $mirrorRep $numberOfReviewersPerWorkTableList $conferenceAcronym $optionTableList $defaultTableList $programCommitteeChairEMailAddressTableList $cameraReadySubmissionDeadlineTableList $submissionFormRep $submissionFormLanguageRep $conferenceHomePage $SMTPServer $numberOfReviewersPerWorkTableList $claimingDeadlineTableList $numberOfWorksPerReviewerTableList $alternateUserTableList $filePath $writeUserCodedPassword $loCoInId $loCoInRep $loBiMiRep $clientServerAddressWithIP $progressKey $applicationNameForReverseEngineering $applicationRuningTime $applicationFileName $registrationPassword]
# setting global variables for the slave
	interp eval slave {foreach {currentRep language languageRep1 languageRep2 homePath bgColor background bgProperties fontTag fontTag2 siteList cgiList envList targetFileDirname targetFileRootName targetFileExtension targetFileType storeTclPage dirName localSite timePeriod thisRepository thisIdentifier cssFileURL serverAddress serverAddressWithIP metadataRep title author identifier parameterlist codedPassword optionTable2List errorTrace tcl_platform(os) window mirrorRep numberOfReviewersPerWorkTableList conferenceAcronym optionTableList defaultTableList programCommitteeChairEMailAddressTableList cameraReadySubmissionDeadlineTableList submissionFormRep submissionFormLanguageRep conferenceHomePage SMTPServer numberOfReviewersPerWorkTableList claimingDeadlineTableList numberOfWorksPerReviewerTableList alternateUserTableList filePath writeUserCodedPassword loCoInId loCoInRep loBiMiRep clientServerAddressWithIP progressKey applicationNameForReverseEngineering applicationRuningTime applicationFileName registrationPassword} [Import] {break}}
	interp eval slave {array set cgi $cgiList}
	interp eval slave {array set env $envList}
	interp eval slave {array set environment $envList}
	if [info exists optionTable2] {interp eval slave {array set optionTable2 $optionTable2List}}
	if [info exists numberOfReviewersPerWorkTable] {interp eval slave {array set numberOfReviewersPerWorkTable $numberOfReviewersPerWorkTableList}}
	if [info exists claimingDeadlineTable] {interp eval slave {array set claimingDeadlineTable $claimingDeadlineTableList}}
	if [info exists numberOfWorksPerReviewerTable] {interp eval slave {array set numberOfWorksPerReviewerTable $numberOfWorksPerReviewerTableList}}
	if [info exists alternateUserTable] {interp eval slave {array set alternateUserTable $alternateUserTableList}}
	if [info exists optionTable] {interp eval slave {array set optionTable $optionTableList}}
	if [info exists defaultTable] {interp eval slave {array set defaultTable $defaultTableList}}
	if [info exists programCommitteeChairEMailAddressTable] {interp eval slave {array set programCommitteeChairEMailAddressTable $programCommitteeChairEMailAddressTableList}}
	if [info exists cameraReadySubmissionDeadlineTable] {interp eval slave {array set cameraReadySubmissionDeadlineTable $cameraReadySubmissionDeadlineTableList}}
#	interp invokehidden slave source $homePath/col/$URLibServiceRepository/doc/utilities1.tcl
#	interp invokehidden slave source $homePath/col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl
#	interp invokehidden slave source $homePath/col/$languageRep2/doc/mirror/${language}SearchResult.tcl	;# see CreateOutput
	if $safeFlag {interp expose slave source}	;# needed because xxFillingInstructions.tcl contains a source
	if $safeFlag {interp expose slave encoding}	;# used in LoopOverEntries
	if [file isdirectory $homePath/col/iconet.com.br/banon/2009/09.04.15.17/doc/tcllib-1.12] {
# tcllib 
		interp eval slave [list source $homePath/col/iconet.com.br/banon/2009/09.04.15.17/doc/tcllib-1.12/modules/math/linalg.tcl]
		interp eval slave [list source $homePath/col/iconet.com.br/banon/2009/09.04.15.17/doc/tcllib-1.12/modules/math/constants.tcl]
		interp eval slave [list source $homePath/col/iconet.com.br/banon/2009/09.04.15.17/doc/tcllib-1.12/modules/math/math.tcl]	;# file dirname and file join commands have been changed to regsub and join in math/statistics.tcl by GJFB on 2011-05-26
		interp eval slave [list source $homePath/col/iconet.com.br/banon/2009/09.04.15.17/doc/tcllib-1.12/modules/math/statistics.tcl]	;# Inverse-cdf-toms322 - file dirname and file join commands have been changed to regsub and join in math/math.tcl by GJFB on 2011-05-26 since the file command is not safe
		interp eval slave [list source $homePath/col/iconet.com.br/banon/2009/09.04.15.17/doc/tcllib-1.12/modules/math/polynomials.tcl]
		interp eval slave [list source $homePath/col/iconet.com.br/banon/2009/09.04.15.17/doc/tcllib-1.12/modules/math/special.tcl]	;# erf - file dirname and file join commands have been changed to regsub and join in math/math.tcl by GJFB on 2011-05-26
	}
	interp eval slave [list source $homePath/col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl]
	interp eval slave [list source $homePath/col/$URLibServiceRepository/doc/utilities1.tcl]
	interp eval slave [list source $homePath/col/$URLibServiceRepository/doc/utilities3.tcl]
	interp eval slave [list source $homePath/col/$URLibServiceRepository/doc/accentTables.tcl]	;# see ComputeFieldValueList, DisplayMultipleSearch and DisplayLetterBar
	interp eval slave [list source $homePath/col/$URLibServiceRepository/doc/parseXML.tcl]	;# see DisplayMultipleSearch
	interp eval slave [list source $homePath/col/$languageRep2/doc/mirror/${language}SearchResult.tcl]	;# see CreateOutput
	interp eval slave [list source $homePath/col/$languageRep2/doc/${language}FillingInstructions.tcl]	;# see LoopOverEntries
	interp eval slave [list source $homePath/col/$languageRep2/doc/mirror/${language}FieldName.tcl]	;# for full format (DisplaySearch)
	
	if [string equal {iconet.com.br/banon/2000/12.30.22.55} $thisRepository] {
# starting URLibService
		interp eval slave [list source $homePath/col/$env(URLIB_SERVICE_REP)/doc/knownPathArray.tcl]
	}
	if [file exists $homePath/col/$thisRepository/auxdoc/cgiArray.tcl] {
# used for example by iconet.com.br/banon/2007/01.07.13.17/doc/start.html
		interp eval slave [list source $homePath/col/$thisRepository/auxdoc/cgiArray.tcl]
	}
	interp eval slave {set log {}}
	if [file exists $dirName/searchResult.tcl] {
		interp eval slave [list source $dirName/searchResult.tcl]	;# set searchResultList
		interp eval slave {array set searchResultArray $searchResultList}	;# array set searchResultArray (in save interpreter)
	}
	if $safeFlag {
#		interp hide slave source
		interp expose slave socket	;# needed to make search
#		interp expose slave vwait
		interp expose slave fconfigure	;# needed to configure socket channel
	}
# puts {Content-Type: text/html}
# puts {}
# puts [interp eval slave [list info exists {translationTable(Journal Article)}]]
# puts [interp eval slave [list set siteList]]

# SUBST 1
# restricted names:
# numberOfSites
# numberOfActiveSites
# listOfInactiveSites
## errorLogPath used by DisplayMultipleSearch
# localSite used in connection with ReturnTheMostRecentEntries
	set fileContent2 [ProcessBrackets $fileContent]
# 	if [catch {subst $fileContent2} fileContent] #
 	if [catch {interp eval slave [list subst $fileContent2]} fileContent] {
		set date [clock format [clock seconds] -format "%d/%m/%y %H:%M"]
		return -code error "$date
CreateTclPage (first substitution):
$errorInfo
while making substitution within:
$fileContent2"
	} else {
		set log [join [interp eval slave {set log}] \n]
		if ![string equal {} $log] {
			Store log $errorLogPath auto 0 a
		}
# Create @preamble.inc and @document.inc
# @preamble.inc and @document.inc are used in book.tex
		if [interp eval slave {info exists latexOptionList}] {
			set latexOptionList [interp eval slave {set latexOptionList}]
			if {[lsearch $latexOptionList {createeditedbook}] != -1} {
				set preambleContent [join [interp eval slave {set preambleContent}] \n]
				Store preambleContent $homePath/col/$thisRepository/doc/@preamble.inc
				set documentContent [join [interp eval slave {set documentContent}] \n]
				Store documentContent $homePath/col/$thisRepository/doc/@document.inc
			}
			if {[lsearch $latexOptionList {createpagelistfile}] != -1} {
				set pageListContent [interp eval slave {set pageListContent}]
				set pageListContent2 {}
				foreach line $pageListContent {
					if [string equal {-} $line] {
# line is -
						if [string equal {} $pageListContent2] {
							set firstPage 1
						} else {
							set lastLine [lindex $pageListContent2 end]
							foreach {rep pages} $lastLine {break}
							regexp {(.*)-(.*)} $pages m firstPage lastPage
							set firstPage [expr $lastPage + 1 + $lastPage%2]
						}
						set lastPage $firstPage
						set pageListLine "- $firstPage-$lastPage"
						lappend pageListContent2 $pageListLine
					} else {
# line is repName
						set repName $line
#						foreach rep-i [FindMetadataRepositories "repository, $repName" 0 [list $serverAddressWithIP] {} yes yes] {break}
#						SetFieldValue $serverAddressWithIP ${rep-i} {targetfile}
#						set targetFile $targetfile
						set targetFile [ReturnFieldValueList $repName targetfile $serverAddressWithIP]

						regsub -all {/} $repName {==} repName2
						regsub -all {\.} $repName2 {=} repName2

						set scriptRepository dpi.inpe.br/banon-pc2@80/2007/06.12.21.20	;# A Tcl CGI script to run pdfinfo
						if {[file isdirectory $homePath/col/$scriptRepository] && \
						$tcl_platform(platform) == "windows"} {
							set siteToReturnPDFInfo hermes2.dpi.inpe.br	;# for testing
						} else {
							set siteRep [FindSite2 $scriptRepository]
#							set siteToReturnPDFInfo [ReturnHTTPHost [lindex $siteRep 0]]
							set siteToReturnPDFInfo [lindex $siteRep 0]	;# added by GJFB on 2013-08-15 - ReturnHTTPHost not needed (called in GetURLPropertyList)
						}

						set scriptSite $siteToReturnPDFInfo
						set scriptName pdfInfo.cgi
						set sourceFileName $targetFile
						set queryString "repname=$repName"
if 1 {
						if [catch {RunRemoteCGIScript $scriptSite $scriptRepository $scriptName $repName \
							$sourceFileName $queryString} message] {
							return -code error $message
						}
# numberOfPages
# $cmd = 'pdfinfo '.$file.' | grep "Pages:"'; ($head,$numpages) = split(" ",`$cmd`);
						foreach {m numberOfPages} [join [Grep "Pages:" [split $message \n]]] {break}
} else {
# testing
	set numberOfPages 12
}
						set lastLine [lindex $pageListContent2 end]
						foreach {rep pages} $lastLine {break}
						regexp {(.*)-(.*)} $pages m firstPage lastPage
						set firstPage [expr $lastPage + 1 + $lastPage%2]
						set lastPage [expr $firstPage + $numberOfPages - 1]
						set pageListLine "$repName $firstPage-$lastPage"
						lappend pageListContent2 $pageListLine
					}
				}
				set pageListContent3 [join $pageListContent2 \n]
				Store pageListContent3 $homePath/col/$thisRepository/doc/pageList.txt
			}
		}
# Create @preamble.inc and @document.inc - end
 
		if [interp eval slave {info exists totalNumberOfSearches}] {
			set totalNumberOfSearches [interp eval slave {set totalNumberOfSearches}]
			set searchResultList [interp eval slave {array get searchResultArray}]	;# array get searchResultArray (from save interpreter)
			set numberOfSatisfiedSearches [expr [llength $searchResultList] / 2]
#			if [string equal $numberOfSatisfiedSearches $totalNumberOfSearches] #	;# commented by GJFB on 2024-02-04
			if [expr $numberOfSatisfiedSearches >= $totalNumberOfSearches] {	;# added by GJFB on 2024-02-04
# all the queries have been satisfied
				file delete $dirName/searchResult.tcl
#				file delete $dirName/@progress.txt
				set log "CreateTclPage: all the $totalNumberOfSearches searches have been made."	;# added by GJFB on 2017-07-15 (was in DisplayNumber)
				Store log $errorLogPath auto 0 a	;# added by GJFB on 2017-07-15
			} else {
# not all the queries have been satisfied
				StoreArray searchResultList $dirName/searchResult.tcl w list listforarray 1
				return -code error "CreateTclPage: just $numberOfSatisfiedSearches out of $totalNumberOfSearches queries have been satisfied"
			}
		}

# freezeSearchResult		
		if [interp eval slave {info exists freezeSearchResult}] {
			set freezeSearchResult [interp eval slave {set freezeSearchResult}]
		} else {
			set freezeSearchResult 0	;# don't freeze, leave the search be done at any time
		}
		
		set fileContent [UnProcessBrackets $fileContent]
# set xxx "CreateTclPage: fileContent = $fileContent"
# Store xxx C:/tmp/bbb.txt binary 0 a

		if [string equal 1 $numberOfSubstitutions] {return $fileContent}
# Store fileContent $homePath/xxx
		set fileContent2 [ProcessBrackets $fileContent]
# SUBST 2
#		if [catch {subst $fileContent2} fileContent] #
 		if [catch {interp eval slave [list subst $fileContent2]} fileContent] {
if 1 {
		set date [clock format [clock seconds] -format "%d/%m/%y %H:%M"]
		return -code error "$date
CreateTclPage (second substitution):
$errorInfo
while making substitution within:
$fileContent2"
} else {
# cr$30 in a title is not an error
		set fileContent $fileContent2
}
		}
		set fileContent [UnProcessBrackets $fileContent]
	}
	return $fileContent
}

# CreateTclPage - end
# ----------------------------------------------------------------------
# CaptureDocumentClassFile
# used by CreateTclPage only

proc CaptureDocumentClassFile {thisRepository documentClass documentClassURL} {
	global homePath
	global errorLogPath	;# set in CreateTclPageFile
	global targetFileDirname	;# set by ProcessTclPage (see cgi/submit.tcl) - added by GJFB on 2022-08-19 - required whenever targetFileDirname is not empty
	global documentClassPath	;# set in this procedure and used in CreateTclPage - added by GJFB on 2022-08-26

# puts --$targetFileDirname--
 	
	package require http
	
# HTTP::GETURL - 1
	set 302Flag 0	;# added by GJFB on 2023-06-06 to solve error: <can't read "302Flag": no such variable> when # 2 below occurs (when m16 is down)
	if [catch {http::geturl [ConvertURLToHexadecimal $documentClassURL]} token1] {
# 1
		set log [list {CaptureDocumentClassFile (1): url not found} $documentClassURL $token1]
		Store log $errorLogPath auto 0 a
	} else {
		if ![regexp {302 Found} [http::code $token1]] {
# 2
			set log [list {CaptureDocumentClassFile (2): url not found} $documentClassURL [http::code $token1]]
			Store log $errorLogPath auto 0 a
		} else {
# 302
			set data [http::data $token1]
# puts --$data--
			if ![regexp {[hH][rR][eE][fF]="(https?://[^/]+/col/[^"]+)"} $data m redirectedURL] {	;# "
				regexp {[hH][rR][eE][fF]="(https?://[^/]+/[^"]+)"} $data m redirectedURL	;# "
			}
			
# HTTP::GETURL - 2
# puts 2-$redirectedURL
#			set fileId2 [open $homePath/col/$thisRepository/doc/$documentClass.cls w]	;# commented by GJFB on 2022-08-26
#			if [catch {http::geturl [ConvertURLToHexadecimal $redirectedURL] -binary 1 -channel $fileId2} token2] #	;# commented by GJFB on 2022-08-26
			if [catch {http::geturl [ConvertURLToHexadecimal $redirectedURL]} token2] {	;# added by GJFB on 2022-08-26
# 3
				set log [list {CaptureDocumentClassFile (3): url not found} $redirectedURL $token2]
				Store log $errorLogPath auto 0 a
			} else {
#				set 302Flag 0	;# commented by GJFB on 2023-06-06 - agora above
				if ![regexp {200 OK} [http::code $token2]] {
					if ![regexp {302 Found} [http::code $token2]] {
# 4
						set log [list {CaptureDocumentClassFile (4): url not found} $redirectedURL [http::code $token2]]
						Store log $errorLogPath auto 0 a
					} else {
# 302
						set 302Flag 1
					}
				} else {
# 200
					set data [http::data $token2]	;# added by GJFB on 2022-08-26 to capture in the .cls file the argument of the LaTeX command \ProvidesClass{}
# puts --$data--
# \ProvidesClass{tdiinpe}[2019/04/02 v1.36]
# \ProvidesClass{./template/tdiinpe}[2022/07/28 v1.37]
# puts [regexp {[^%]+\\ProvidesClass\{(.+)\}} $data m documentClassPath]
					if ![regexp {[^%]+\\ProvidesClass\{([^\}]+)\}} $data m documentClassPath] {
# 5
						set log [list {CaptureDocumentClassFile (5): document class path not found}]
						Store log $errorLogPath auto 0 a
					} else {
# puts --$documentClassPath--
						if [string equal {} $targetFileDirname] {	;# if added by GJFB on 2022-08-19
							file mkdir [file dirname $homePath/col/$thisRepository/doc/$documentClassPath]
							Store data $homePath/col/$thisRepository/doc/$documentClassPath.cls
						} else {
							file mkdir [file dirname $homePath/col/$thisRepository/doc/$targetFileDirname/$documentClassPath]
							Store data $homePath/col/$thisRepository/doc/$targetFileDirname/$documentClassPath.cls
						}
					}
				}
				http::cleanup $token2
			}
#			close $fileId2	;# commented by GJFB on 2022-08-26
		}
	}
	http::cleanup $token1
	
	if $302Flag {return $redirectedURL}
}

# CaptureDocumentClassFile - end
# ----------------------------------------------------------------------
# CreateAlternatePath
# used in ProcessTclPage (cgi/submit.tcl) and CreatePage (cgi/createpage.tcl)
# doc/page.html -> doc/@page.html (alternate path)
# doc/paper.tex -> doc/@paper.pdf (alternate path)
# doc/paper.tex -> doc/paper.pdf (alternate path) when the @schedule.tcl file doesn't exist
# directory values are 0 or 1; 0 means to use doc and 1 auxdoc
# 1 is used in CreateMirror (see About)

# example of path:
# set path $env(DOCUMENT_ROOT)/col/$mirrorHomePageRep/doc/${language}About.html

proc CreateAlternatePath {path {directory 0}} {
	upvar homePath homePath

	set dirName [file dirname $path]
	set fileName [file tail $path]	;# enAbout.html
	set flag [regsub -nocase {\.tex$} $fileName {.pdf} fileName]	;# .tex -> .pdf
	if $flag {
		if {![file exists $dirName/@schedule.tcl] && \
		![file exists $homePath/col/$dirName/@schedule.tcl]} {
# the second "file exists" is needed when CreateAlternatePath is called from CreatePage (see createpage.tcl)
			return $dirName/$fileName
		}
	}
	if [regexp {^/[^/]*/[^/]*/[^/]*/[^/]*/doc/goto-?/[^/]*/[^/]*/[^/]*/[^/]*} $path] {
		return $path	;# added by GJFB on 2011-08-30 - used when clicking goto- links in col/iconet.com.br/banon/2002/02.04.12.37/doc/target.html
	}
	if $directory {
		return $dirName/../auxdoc/@$fileName	;# add @
	} else {
		return $dirName/@$fileName	;# add @
	}
}

# CreateAlternatePath - end
# ----------------------------------------------------------------------
# CreateTclPageFile
# used by the cgi scripts: CreatePage and Submit
# path must be absolute, is the tex path
# alternatePath must be absolute, is the pdf path
# >>> it calls CreateTclPage above
# writeUserCodedPassword used by Load2
# numberOfCompilations value is 1, 2, 3, 4 or 5 - used when compiling tex file

proc CreateTclPageFile {path alternatePath language languageRep2 {writeUserCodedPassword {}} {numberOfCompilations 5}} {
	global env
	global localSite	;# set in CreatePage and Submit
	global timePeriod		;# set by TestForTclPageUpdate, used in CreateTclPage (with enAbout.html, ...)
	global storeTclPage	;# set by TestForTclPageUpdate
	global storeOldTclPage	;# set by TestForTclPageUpdate
	global freezeSearchResult	;# set in a tcl page; provided by CreateTclPage
	global errorLogPath	;# set in this procedure
	global dirName		;# used by CreateTclPage and DisplayNumberOfEntries
	global thisRepository	;# set by CreatePage or Submit
	global homePath
	global URLibServiceRepository	;# set by CreatePage or Submit
#	global authorIndexCounter	;# set by CreateTclPageFile and used by DisplaySearch
	global targetFile		;# set by CreatePage (see cgi/createpage.tcl) or ProcessTclPage (see cgi/submit.tcl)
	global targetFileType	;# set by CreatePage (see cgi/createpage.tcl) or ProcessTclPage (see cgi/submit.tcl)
	global errorInfo
	global serverAddressWithIP ;# set by CreatePage or Submit
	global targetFileDirname	;# set by ProcessTclPage (see cgi/submit.tcl) - added by GJFB on 2022-08-19 - required whenever targetFileDirname is not empty

	set col ../../../../..
# set xxx "CreateTclPageFile: language = $language"
# Store xxx C:/tmp/bbb.txt binary 0 a

if 0 {
 puts {Content-Type: text/html}
 puts {}
 puts $path
# => c:/users/geral/onedrive/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/test4/test4.tex
 puts $alternatePath
# => c:/users/geral/onedrive/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/test4/test4.pdf
 puts [CallTrace]
}

## thisRepository
##	regexp "$env(DOCUMENT_ROOT)/col/(\[^/\]*/\[^/\]*/\[^/\]*/\[^/\]*)" $path m thisRepository
#	regsub -all { } [lrange [file split $env(PATH_INFO)] 1 4] {/} thisRepository

	source ../$col/$languageRep2/doc/mirror/${language}FieldName.tcl	;# for full format

# Check if thisRepository is a child of a submission form repository
# if it is, it is assumed that its content is a subject list (used within the reviewing process)
# and the above fileContent is overwritten for security reason
	set thisRepositoryMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $thisRepository]]
	SetFieldValue $serverAddressWithIP $thisRepositoryMetadataRep-0 {parentrepositories}

# targetFileAbsolutePath	
	set targetFileAbsolutePath $homePath/col/$thisRepository/doc/$targetFile

# example: running http://gjfb.home/createpage.cgi/urlib.net/www/2015/01.23.02.17/doc/2014/tclPage.html results in:
# Store path C:/tmp/bbb.txt binary 0 a
# => c:/users/gerald banon/urlib 2/col/urlib.net/www/2015/01.23.02.17/doc/2014/tclPage.html
# Store targetFileAbsolutePath C:/tmp/bbb.txt binary 0 a
# => c:/users/gerald banon/urlib 2/col/urlib.net/www/2015/01.23.02.17/doc/tclPage.html
		
# LOAD
#	Load $path fileContent
	Load $targetFileAbsolutePath fileContent	;# added by GJFB on 2015-01-23 in order to allow working with a file path after doc and before $targetFile like 2015 in doc/2015/tclPage.txt (example: id J8LNKB5R7W/3HQN8GE and id 8JMKD3MGP5W34M/3GFNBRL)
# tclPage.txt (target file name)
# doc/2015/tclPage.txt (last part of path)
# doc/tclPage.txt (last part of targetFileAbsolutePath)
# regexp c:/users/gerald banon/urlib 2/col/urlib.net/www/2015/01.23.02.17/doc/(.*)/?tclPage.txt c:/users/gerald banon/urlib 2/col/urlib.net/www/2015/01.23.02.17/doc/tclPage.txt m filePath

# filePath
	regexp $homePath/col/$thisRepository/doc/(.*?)/?$targetFile $path m filePath	;# 2015
if 0 {
# http://gjfb.home/rep/urlib.net/www/2015/01.23.02.17
# http://gjfb.home/createpage.cgi/urlib.net/www/2015/01.23.02.17/doc/tclPage.txt
# http://gjfb.home/createpage.cgi/urlib.net/www/2015/01.23.02.17/doc/2014/tclPage.txt
# http://gjfb.home/createpage.cgi/urlib.net/www/2015/01.23.02.17/doc/2015/tclPage.txt
 puts {Content-Type: text/html}
 puts {}
 puts $storeTclPage
 puts $path
 puts --$filePath--
# set xxx --$filePath--
# Store xxx C:/tmp/bbb.txt binary 0 a
}
	
	set parentMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $parentrepositories]]
	SetFieldValue $serverAddressWithIP $parentMetadataRep-0 {contenttype}
	if [string equal {Submission Form} $contenttype] {
		Load $homePath/col/$languageRep2/doc/${language}SubjectList.html fileContent
	}
# Check if thisRepository is a child of a submission form repository - end

#	if ![info exists timePeriod] {TestForTclPageUpdate $thisRepository $path $alternatePath}
	if ![info exists timePeriod] {TestForTclPageUpdate $thisRepository $targetFileAbsolutePath $alternatePath}
	
	set dirName [file dirname $path]
	set errorLogPath $homePath/col/$thisRepository/doc/@errorLog
if 1 {
#	if [file exists $homePath/col/$thisRepository/doc/@schedule.tcl] #
		set log [clock format [clock seconds] -format "%d/%m/%y %H:%M"]
		Store log $errorLogPath auto 0 a
#	#
}
# set xxx 2
# Store xxx C:/tmp/bbb.txt binary 0 a

	if [regexp -nocase {tex} $targetFileType] {
# LaTeX
		regsub {\.pdf$} $alternatePath {} alternatePathWithoutExtension	;# alternatePathWithoutExtension value can be modifed by CreateTclPage (see added code by GJFB on 2022-09-03)
	}
# CREATE
	if [catch {CreateTclPage $thisRepository $fileContent $language $languageRep2 $path $targetFileAbsolutePath $filePath $writeUserCodedPassword} fileContent] {
if 0 {
		set log [clock format [clock seconds] -format "%d/%m/%y %H:%M"]
		Store log $errorLogPath auto 0 a
}
		Store errorInfo $errorLogPath auto 0 a
	} else {
# targetFileType is for example: pdf, html, htm, ...
		if {$storeTclPage || [regexp -nocase {tex} $targetFileType]} {
# store
if 0 {
# commented by GJFB on 2015-08-25 - now the current version is duplicated in a file whose name contains the date of the current version (see below)
# Keep the old versions
			if {[info exists storeOldTclPage] && $storeOldTclPage} {
				if [file exists $alternatePath] {
					set mtimePattern [clock format [file mtime $alternatePath] -format %Y-%m-%d-%H-%M-%S]	;# 2006-11-29-18-06-43
					set fileName [file tail $alternatePath]	;# @tclPage.htm
					regsub {\.} $fileName "$mtimePattern." fileName2	;# @tclPage2006-11-29-18-06-43.htm
					file rename $alternatePath $dirName/$fileName2
				}
			}
# Keep the old versions - end
}
			if [regexp -nocase {tex} $targetFileType] {
# LaTeX
#				regsub {\.pdf$} $alternatePath {} alternatePathWithoutExtension
# puts $alternatePathWithoutExtension
				if [regexp {^set fileContentList\s} $fileContent] {
# multiple file content
# the file content must be stored in more than one file
# syntax is: set fileContentList {{@report.tex} {...} {figure1.dat} {...} {figure1.gle} {...}}
# syntax is: set fileContentList {{} {...} {figure1.dat} {...} {figure1.gle} {...}}
# an empty file name is equivalent to the alternate target file (e.g., @report.tex)
# file name must not begin with ../ (security issue)
#					eval $fileContent	;# creates fileContentList - security issue
					interp create -safe slave2
# EVAL
					interp eval slave2 [list eval $fileContent]	;# creates fileContentList
					set fileContentList [interp eval slave2 {set fileContentList}]
					foreach {fileName fileContent} $fileContentList {
						if [string equal {} $fileName] {
							set fileName [file tail $alternatePathWithoutExtension.tex]	;# @report.tex
						}
# STORE
						if ![regexp {^\.\./} $fileName] {Store fileContent $dirName/$fileName}
# set xxx --$fileContent--
# Store xxx C:/tmp/bbb.txt binary 0 a
						if [regexp -nocase {\.gle$} $fileName] {
# .gle
							if [catch {Run-gle $dirName $fileName {-d pdf -d jpg -d png -tr -dpi 300 -vb 0}}] {
								set log [clock format [clock seconds] -format "%d/%m/%y %H:%M"]
								Store log $errorLogPath auto 0 a
								Store errorInfo $errorLogPath auto 0 a
							} 
						}
					}
				} else {
# STORE
# fileContent contains the script interpertation
					if ![string equal {} $targetFileDirname] {set targetFileDirname $targetFileDirname/}	;# if added by GJFB on 2022-08-19
#					if [file exists $homePath/col/$thisRepository/doc/@schedule.tcl] #	;# commented by GJFB on 2022-08-19
					if [file exists $homePath/col/$thisRepository/doc/$targetFileDirname@schedule.tcl] {	;# added by GJFB on 2022-08-19
						Store fileContent $alternatePathWithoutExtension.tex
					}
				}
if 0 {
 puts {Content-Type: text/html}
 puts {}
 puts $alternatePathWithoutExtension
# => c:/users/geral/onedrive/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/test4/test4
 puts $targetFile
# => test4/test4.tex
 puts $dirName
# => c:/users/geral/onedrive/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/test4
 puts $numberOfCompilations
}
				Run-pdflatex $alternatePathWithoutExtension $targetFile $dirName $numberOfCompilations
			} else {
# not LaTeX
				if [regexp {^set fileContentList\s} $fileContent] {
# multiple file content
# the content file must be stored in more than one file
# syntax is: set fileContentList {{@tclPage.html} {...} {tclPage.dat} {...} {tclPage.gle} {...}}
# syntax is: set fileContentList {{} {...} {tclPage.dat} {...} {tclPage.gle} {...}}
# an empty file name is equivalent to the alternate target file (e.g., @tclPage.html)
# Store fileContent c:/tmp/xxx
# fileContent contains the script interpertation
#					eval $fileContent	;# creates fileContentList
					interp create -safe slave2
# EVAL
					interp eval slave2 [list eval $fileContent]	;# creates fileContentList
					set fileContentList [interp eval slave2 {set fileContentList}]
					foreach {fileName fileContent} $fileContentList {
						if [string equal {} $fileName] {
							set fileName [file tail $alternatePath]	;# @tclPage.htm
						}
# STORE
						if ![regexp {^\.\./} $fileName] {Store fileContent $dirName/$fileName}
						if [regexp -nocase {\.gle$} $fileName] {
# .gle
							if [catch {Run-gle $dirName $fileName {-d jpg -r 200 -vb 0}}] {
								set log [clock format [clock seconds] -format "%d/%m/%y %H:%M"]
								Store log $errorLogPath auto 0 a
								Store errorInfo $errorLogPath auto 0 a
							} 
						}
					}
				} else {
# STORE
					if ![string equal {} $filePath] {
						if ![file exists $homePath/col/$thisRepository/doc/$filePath] {
							if [string equal [clock format [clock seconds] -format %Y] $filePath] {
# filePath == current year
# create a new year directory
								file mkdir $homePath/col/$thisRepository/doc/$filePath
							}
						}
					}
					Store fileContent $alternatePath
## Keep the old versions
# Duplicate the current version
# added by GJFB on 2015-08-25
					if {[info exists storeOldTclPage] && $storeOldTclPage} {
						set currentTime [clock format [file mtime $alternatePath] -format %Y-%m-%d-%H-%M-%S]	;# 2006-11-29-18-06-43
						if $freezeSearchResult {
							global targetFileDirname	;# provided in CreateTclPage (dirname of the target file for thisRepository)
							global targetFileRootName	;# provided in CreateTclPage (rootname of the target file for thisRepository)
							global targetFileExtension	;# provided in CreateTclPage (extension of the target file for thisRepository)
							file mkdir $homePath/col/$thisRepository/doc/$targetFileDirname/@$targetFileRootName$currentTime
							set fileNameList [glob -directory $homePath/col/$thisRepository/doc/$targetFileDirname @@$targetFileRootName*$targetFileExtension]
							lappend fileNameList $homePath/col/$thisRepository/doc/$targetFileDirname/@$targetFileRootName$targetFileExtension
							foreach fileName $fileNameList {
								set fileTail [file tail $fileName]
								file copy $fileName $homePath/col/$thisRepository/doc/$targetFileDirname/@$targetFileRootName$currentTime/$fileTail
							}
							set fileName $homePath/col/$thisRepository/doc/$targetFileDirname/@$targetFileRootName.xml	;# the code that create this file (ex: @tclPage.xml) is in the target file (ex: tclPage.htm)
# => C:/Users/Sony/URLib 2/col/urlib.net/www/2015/08.19.17.43/doc/@tclPage.xml
							Load $fileName fileContent
# <url>http://gjfb.home/urlib.net/www/2015/08.19.17.43/./@@tclPage1.htm</url>
# -> <url>http://gjfb.home/urlib.net/www/2015/08.19.17.43/./@tclPage2015-08-30-00-50-27/@@tclPage1.htm</url>
#							Load $fileName fileContent
if 0 {
# commented by GJFB on 2019-01-23 to avoid using staticIPFlag that may be empty when communication with urlib.net fails at ./post &
							set staticIPFlag [Execute $serverAddressWithIP [list ReturnStaticIPFlag] 0]
							if $staticIPFlag {
								regsub -all "<url>http://urlib.net/$thisRepository/$targetFileDirname/@@${targetFileRootName}(\\d+)$targetFileExtension</url>" $fileContent "<url>http://urlib.net/$thisRepository/$targetFileDirname/@$targetFileRootName$currentTime/@@$targetFileRootName\\1$targetFileExtension</url>" fileContent
							} else {
								regsub -all "<url>http://$localSite/$thisRepository/$targetFileDirname/@@${targetFileRootName}(\\d+)$targetFileExtension</url>" $fileContent "<url>http://$localSite/$thisRepository/$targetFileDirname/@$targetFileRootName$currentTime/@@$targetFileRootName\\1$targetFileExtension</url>" fileContent
							}
} else {
							regsub -all "<url>http://(\[^/\]+)/$thisRepository/$targetFileDirname/@@${targetFileRootName}(\\d+)$targetFileExtension</url>" $fileContent "<url>http://\\1/$thisRepository/$targetFileDirname/@$targetFileRootName$currentTime/@@$targetFileRootName\\2$targetFileExtension</url>" fileContent
}
							set fileTail [file tail $fileName]
# => @tclPage.xml
							Store fileContent $homePath/col/$thisRepository/doc/$targetFileDirname/@$targetFileRootName$currentTime/$fileTail
						} else {
							set fileName [file tail $alternatePath]	;# @tclPage.htm
							regsub {(.*)\.} $fileName "\\1$currentTime." fileName2	;# @tclPage2006-11-29-18-06-43.htm
							file copy $alternatePath $dirName/$fileName2
						}
					}
## Keep the old versions - end
# Duplicate the current version - end

				}
			}
		} else {
# don't store
			if !$storeTclPage {file delete $alternatePath}	;# added by GJFB on 2020-04-26
			return $fileContent
		}
	}
}

# CreateTclPageFile - end
# ----------------------------------------------------------------------
# Run-gle
# used by some cgi scripts
# used in CreateTclPageFile (only)

proc Run-gle {dirName fileName option} {
	global env
	global homePath
	global tcl_platform
	global serverAddressWithIP ;# set by CreatePage or Submit
	global errorLogPath	;# set in CreateTclPageFile

	source $homePath/col/$env(URLIB_SERVICE_REP)/doc/knownPathArray.tcl	;# needed by SetPath
# glePath
	set glePath [SetPath gle]
	if [string equal {} $glePath] {
		error "gle not found in the following known paths: \n[join [ListPath gle] \n]"
	} else {
		if {$tcl_platform(platform) == "windows"} {
# windows
# Update glerc file (to be effective post must be RUN AS ADMINISTRATOR)
			regsub {bin/gle.exe} $glePath {glerc} glercPath
			
			Load $glercPath glercFileContent
			
			regexp {current = "(.*?)"} $glercFileContent m version
			
			set pdflatexPath [SetPath pdflatex]
			set latexPath [SetPath latex]
			set dvipsPath [SetPath dvips]
			set ghostscriptPath [SetPath ghostscript]
			set libgsPath [SetPath libgs]
#			source $homePath/col/$env(URLIB_SERVICE_REP)/doc/knownRepositoryArray.tcl	;# needed by SetRepository
#			set gleRepository [SetRepository gle]
#			set gleMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $gleRepository]]
#			SetFieldValue $serverAddressWithIP $gleMetadataRep-0 {version}
			set glercFileContent "
				begin config gle
					current = \"$version\"
				end config
				
				begin config tools
					pdflatex = \"$pdflatexPath\"
					latex = \"$latexPath\"
					dvips = \"$dvipsPath\"
					ghostscript = \"$ghostscriptPath\"
					libgs = \"$libgsPath\"
				end config
			"
			
			Store glercFileContent $glercPath	;# Store to be effective post must be RUN AS ADMINISTRATOR
			
# Update glerc file - end
		}
	
		set pwd [pwd]
		cd $dirName
# EXEC
#		exec $glePath -d jpg -r 200 $dirName/$fileName
		eval exec [list $glePath] $option [list $dirName/$fileName]	;# dirName is absolute
		cd $pwd
	}
}

# Run-gle - end
# ----------------------------------------------------------------------
# SetRepository
# used in LoadGlobalVariables only
# examples of repositoryName: tcl unzip

proc SetRepository {repositoryName {level 1}} {
	global tcl_platform
	global homePath
	
	upvar $level knownRepositoryArray knownRepositoryArray
	
	if [info exists knownRepositoryArray($repositoryName,$tcl_platform(platform))] {	
		foreach rep $knownRepositoryArray($repositoryName,$tcl_platform(platform)) {
			if [file isdirectory $homePath/col/$rep] {
				return $rep
			}
		}
	}
}

# SetRepository - end
# ----------------------------------------------------------------------
# SetPath

proc SetPath {programName {level 1}} {
	global tcl_platform
	global homePath
	global env
	
	upvar $level knownPathArray knownPathArray
	
	if ![info exists knownPathArray] {	;# added by GJFB on 2016-05-20 - used in CreateMirror
		source $homePath/col/$env(URLIB_SERVICE_REP)/doc/knownPathArray.tcl	;# set knownPathArray
	}
	
	foreach filePath $knownPathArray($programName,$tcl_platform(platform)) {
		if [file exists $filePath] {
			return $filePath
		}
	}
}

# SetPath - end
# ----------------------------------------------------------------------
# ListPath

proc ListPath {programName {level 1}} {
	global tcl_platform
	
	upvar $level knownPathArray knownPathArray
	
	return $knownPathArray($programName,$tcl_platform(platform))
}

# ListPath - end
# ----------------------------------------------------------------------
# Run-pdflatex
# compile the latex script which is in $alternatePathWithoutExtension.tex
# used by some cgi scripts
# used in CreateTclPageFile (only)
# $alternatePathWithoutExtension
# => c:/users/geral/onedrive/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/test4/test4
# $targetFile
# => test4/test4.tex
# $dirName
# => c:/users/geral/onedrive/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/test4
# numberOfCompilations value is 1, 2, 3, 4, or 5

proc Run-pdflatex {alternatePathWithoutExtension targetFile dirName numberOfCompilations} {
	global env
	global homePath
	global tcl_platform

	source $homePath/col/$env(URLIB_SERVICE_REP)/doc/knownPathArray.tcl	;# set knownPathArray - needed by SetPath
	set pdflatexPath [SetPath pdflatex]
	set bibtexPath [SetPath bibtex]
	set makeindexPath [SetPath makeindex]
	if ![string equal {} $pdflatexPath] {
		set nOC 0	;# number of compilations
		if {$numberOfCompilations == 5} {
			file delete $alternatePathWithoutExtension.toc	;# is used for the bookmarks
			file delete $alternatePathWithoutExtension.bbl
			file delete $alternatePathWithoutExtension.aux	;# aux must be deleted because some attribute values in it must not be consistent with new attribute values in the \documentclass command (e.g., when changing language: brazilian -> english)
			file delete $alternatePathWithoutExtension.out
			file delete $alternatePathWithoutExtension.blg
			file delete $alternatePathWithoutExtension.ind
		}
		set pwd [pwd]
		cd $dirName
		
#		load C:/Users/gerald.banon/Downloads/twapi-3.1.17/twapi/twapi.dll twapi
#		source C:/Users/gerald.banon/Downloads/twapi-3.1.17/twapi/twapi.tcl
#		::twapi::import_commands
	
# EXEC pdflatex (1)
# create the pdf file from tex
#		if [catch {exec $pdflatexPath $alternatePathWithoutExtension.tex} message] # commented by GJFB on 2011-10-15 - \RequirePackage{textcomp}	% usado para \texttildelow, produces an error, nevertheless the right pdf is created
		catch {exec $pdflatexPath $alternatePathWithoutExtension.tex} message
#		catch {exec $pdflatexPath -no-shell-escape $alternatePathWithoutExtension.tex} message
#		catch {shell_execute -verb runas -path [list $pdflatexPath $alternatePathWithoutExtension.tex]} message	;# doesn´t return
#		catch {exec {C:/MiKTeX 2.9/miktex/bin/pdflatex.exe} {c:/users/gerald.banon/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/test/LaTeX1.tex}} message
		if [regexp {! Emergency stop\.} $message] {
# compilation error
				puts {Content-Type: text/html}
				puts {}
				regsub -all {(!.*?\n)} $message {<B style="color:#FFFFFF; background-color:#444444">\1</B>} message
				puts <PRE>$message</PRE>
				LeaveQueue
				exit
		} elseif ![regexp "Transcript written on [file tail $alternatePathWithoutExtension].log." $message] {
# probably an installation problem
				puts {Content-Type: text/html}
				puts {}
				puts "<PRE>patchlevel = [info patchlevel]</PRE>"
				puts "<PRE>error while executing:\nexec [list $pdflatexPath $alternatePathWithoutExtension.tex]</PRE>"
#				puts "<PRE>error while executing:\nexec [list $pdflatexPath -no-shell-escape $alternatePathWithoutExtension.tex]</PRE>"
				puts "<PRE>pdflatex says:\n$message</PRE>"	;# added by GJFB on 2025-01-21
				LeaveQueue
				exit
		}
		incr nOC
# set xxx 1
# set xxx $numberOfCompilations
# Store xxx C:/tmp/bbb.txt binary 0 a
		set alternateTailWithoutExtension [file tail $alternatePathWithoutExtension]	;# @LaTeX1

if 0 {
# EXEC pdflatex
		exec $pdflatexPath $alternatePathWithoutExtension.tex
		Load $alternatePathWithoutExtension.log logFileContent
		if [regexp "No file $alternateTailWithoutExtension.aux" $logFileContent] {
# needed for displaying the table of contents
# EXEC pdflatex
			exec $pdflatexPath $alternatePathWithoutExtension.tex
 		}
		if [file exists $alternatePathWithoutExtension.axx] {
			Load $alternatePathWithoutExtension.axx axxFileContent
			Load $alternatePathWithoutExtension.aux auxFileContent
			if ![string equal $axxFileContent $auxFileContent] {
# the .aux file has been updated
# EXEC bibtex
				exec $bibtexPath $alternatePathWithoutExtension
# EXEC pdflatex
				exec $pdflatexPath $alternatePathWithoutExtension.tex
 			}
		}
}

#		Load $alternatePathWithoutExtension.log logFileContent
		Load $alternatePathWithoutExtension.aux auxFileContent	;# added by GJFB on 2024-12-28
#		if [regexp "No file $alternateTailWithoutExtension.bbl" $logFileContent] #	;# commented by GJFB on 2024-12-28
		if {[regexp {\\bibdata\{.+\}} $auxFileContent]} {	;# added by GJFB on 2024-12-28 - needed to run bibtex only when there is a \bibdata command in .aux, like: \bibdata{abnt-options,./bib/referencia}
# EXEC bibtex
if 0 {
# commented by GJFB on 2019-06-16 - the command below produces a bibtext error: Not writing to /dados/URLib/dados1/URLibGPRB0705/col/sid.inpe.br/gprb0705/2018/02.12.13.45/doc/manuscript.blg (openout_any = p)
			exec $bibtexPath $alternatePathWithoutExtension
} else {
# added by GJFB on 2019-06-16 - for security reason the absolute path is not allowed - the relative path must be used instead
			set currentPath [pwd]
			cd [file dirname $alternatePathWithoutExtension]
#			exec $bibtexPath $alternateTailWithoutExtension	;# commented by GJFB on 2024-12-27
			if [catch {exec $bibtexPath $alternateTailWithoutExtension} message] {	;# added by GJFB on 2024-12-27
				puts {Content-Type: text/html}
				puts {}
				puts "<PRE>error while executing:\nexec [list $bibtexPath $alternateTailWithoutExtension]</PRE>"
				regsub -all {(!.*?\n)} $message {<B style="color:#FFFFFF; background-color:#444444">\1</B>} message
				puts <PRE>$message</PRE>
				LeaveQueue
				exit
			}
			cd $currentPath
}
			incr nOC
		}
		Load $alternatePathWithoutExtension.log logFileContent
		if [regexp "No file $alternateTailWithoutExtension.ind" $logFileContent] {
# -q for quiet
# EXEC makeindex
#			if [catch {exec $makeindexPath -q $alternatePathWithoutExtension.idx} message] #	;# commented by GJFB on 2014-07-14 - cannot be an absolute path with MiKTeX 2.9
#			if [catch {exec $makeindexPath -q $targetFile} message] #	;# commented by GJFB on 2019-02-17 - doesn't work
			set fileName [file rootname [file tail $targetFile]]	;# added by GJFB on 2019-02-17 - test/LaTeX1.tex -> LaTeX1
			if [catch {exec $makeindexPath -q $fileName} message] {
				puts {Content-Type: text/html}
				puts {}
				puts "<PRE>error while executing:\nexec [list $makeindexPath -q $fileName]</PRE>"
				puts <PRE>$message</PRE>
				LeaveQueue
				exit
			}
		}
# set xxx --$message--
# Store xxx C:/tmp/bbb.txt binary 0 a
if 0 {
# EXEC pdflatex (2)
		exec $pdflatexPath $alternatePathWithoutExtension.tex
# set xxx 2
# Store xxx C:/tmp/bbb.txt binary 0 a
## EXEC bibtex
#		exec $bibtexPath $alternatePathWithoutExtension
# EXEC pdflatex (3)
		exec $pdflatexPath $alternatePathWithoutExtension.tex
# set xxx 3
# Store xxx C:/tmp/bbb.txt binary 0 a
# EXEC pdflatex (4)
		exec $pdflatexPath $alternatePathWithoutExtension.tex
# set xxx 4
# Store xxx C:/tmp/bbb.txt binary 0 a
}
		for {set i $nOC} {$i <= [expr $numberOfCompilations - 1]} {incr i} {
#			exec $pdflatexPath $alternatePathWithoutExtension.tex
			catch {exec $pdflatexPath $alternatePathWithoutExtension.tex} message
#			catch {exec $pdflatexPath -no-shell-escape $alternatePathWithoutExtension.tex} message
			if [regexp {! Emergency stop\.} $message] {
# compilation error
					puts {Content-Type: text/html}
					puts {}
					regsub -all {(!.*?\n)} $message {<B style="color:#FFFFFF; background-color:#444444">\1</B>} message
					puts <PRE>$message</PRE>
					LeaveQueue
					exit
			}
		}

# set xxx --$message--
# set xxx [list $nOC $numberOfCompilations]
# Store xxx C:/tmp/bbb.txt binary 0 a

if 0 {
# EXEC pdflatex (5)
		exec $pdflatexPath $alternatePathWithoutExtension.tex
# set xxx 5
# Store xxx C:/tmp/bbb.txt binary 0 a
}
		cd $pwd
if 0 {
		if {$numberOfCompilations == 4} {
			file delete $alternatePathWithoutExtension.aux	;# aux must be deleted because some attribute values in it must not be consistent with new attribute values in the \documentclass command (e.g., when changing language: brazilian -> english)
#			file rename -force -- $alternatePathWithoutExtension.aux $alternatePathWithoutExtension.axx
#			file delete $alternatePathWithoutExtension.log
			file delete $alternatePathWithoutExtension.out
#			file delete $alternatePathWithoutExtension.bbl
			file delete $alternatePathWithoutExtension.blg
			file delete $alternatePathWithoutExtension.ind
#			file delete $alternatePathWithoutExtension.tex
		}
}
	} else {
# pdflatex not found
				puts {Content-Type: text/html}
				puts {}
				puts "
					<PRE>
pdflatex not found at:

[join $knownPathArray(pdflatex,$tcl_platform(platform)) \n]
					</PRE>
				"
				LeaveQueue
				exit
	}
}

# Run-pdflatex - end
# ----------------------------------------------------------------------
# TestForTclPageUpdate
# set timePeriod
# timePeriod = 0 is equivalent to timePeriod = infinite (number of seconds)
# set numberOfSubstitutions
# value is 0, 1 or 2 (default)
# set storeTclPage
# value is 0 or 1 (default), 1 means to store the tcl page as alternatePath
# example of alternatePath: $dirName/@$fileName
# returns 1 (or an integer greater than 1) for updating and 0 otherwise
# repName is the name of the repository in path
# used in CreateTclPageFile, KeepOldVersionOfTeXTargetFile, CreateMirror and CreatePage only

proc TestForTclPageUpdate {repName path alternatePath} {
	global timePeriod		;# set by source $dirName/@schedule.tcl
	global numberOfSubstitutions	;# set by source $dirName/@schedule.tcl - or in this procedure
	global storeTclPage	;# set by source $dirName/@schedule.tcl
	global storeOldTclPage	;# set by source $dirName/@schedule.tcl, used in CreateTclPageFile
	global homePath

	if {[TestContentType $repName {Tcl Page} $homePath] && \
	![file exists $homePath/col/$repName/doc/@progress.txt] && \
	[file exist $homePath/col/$repName/service/userName]} {
		set fileContent {}
		Store fileContent $homePath/col/$repName/doc/@progress.txt	;# used in mirror/xxCover.tcl - if omitted an error (File does not exist) occurs and appears in auxdoc/serverDir/logs/error.log
	}
	set dirName [file dirname $path]
# puts $dirName
# => c:/users/geral/urlib 2/col/dpi.inpe.br/banon/2000/01.23.20.24/doc

# puts $alternatePath
# => c:/gerald/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/@LaTeX1.pdf
# => c:/users/geral/urlib 2/col/dpi.inpe.br/banon/2000/01.23.20.24/doc/../auxdoc/@pt-BRAbout.html

if 0 { 
 puts {Content-Type: text/html}
 puts {}
 puts $path
 puts $alternatePath
 puts "[file exists $alternatePath] [file exists $dirName/@schedule.tcl]"
}
	if [file exists $alternatePath] {
		if [file exists $dirName/@schedule.tcl] {
			if [catch {source $dirName/@schedule.tcl}] {
# wrong content - must be tcl expressions
				set startingTime 02:00:00
#				if [file exists $dirName/mirrorHomePage.html] #	;# commented by GJFB on 2022-12-20 - now mirrorHomePage.html may not exist
				if [regexp {About.html$} $path] {	;# added by GJFB on 2022-12-20
#					set timePeriod 1	;# commented by GJFB on 2022-12-20
					set timePeriod [expr 24*60*60]	;# 1 day	;# added by GJFB on 2022-12-20
				} else {
					set timePeriod 0
				}
				set numberOfSubstitutions 2
				set storeTclPage 1
			} else {
				if ![info exists startingTime] {set startingTime 02:00:00}
#				if [file exists $dirName/mirrorHomePage.html] #	;# commented by GJFB on 2022-12-20 - now mirrorHomePage.html may not exist
				if [regexp {About.html$} $path] {	;# added by GJFB on 2022-12-20
#					if ![info exists timePeriod] #
					if {![info exists timePeriod] || [string equal {1} $timePeriod]} {
#						set timePeriod 1	;# commented by GJFB on 2022-12-20
						set timePeriod [expr 24*60*60]	;# 1 day	;# added by GJFB on 2022-12-20
						StoreDefaultSchedule $repName $path 2 1	;# added by GJFB on 2022-12-20 beacause of the migration of the timePeriod value from 1 to 86400 (1 day)
					}
				} else {
					if ![info exists timePeriod] {set timePeriod 0}
				}
				if ![info exists numberOfSubstitutions] {set numberOfSubstitutions 2}
				if ![info exists storeTclPage] {set storeTclPage 1}
			}
if 0 {
# commented by GJFB on 2023-01-14
			if [catch {clock scan $startingTime -base 109306800} startingSecond] {
# wrong startingTime
				set startingSecond [clock scan 02:00:00 -base 109306800]	;# 109314000
			}
			if [string equal {infinite} $timePeriod] {return 0}
			if !$timePeriod {return 0}	;# timePeriod is 0
			set mtime [file mtime $alternatePath]
			set seconds [clock seconds]
			if {[expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} {
# old tcl page file - update the tcl page file
# let the transition times be = {starting second + n * time period: n = 0, 1, ...}
# since the last update (mtime) at least one transition time occured
				return $timePeriod
			}
} else {
# added by GJFB on 2023-01-14 to use the new procedure ComputeFileUpdateFlag
			set fileUpdateFlag [ComputeFileUpdateFlag $alternatePath $timePeriod $startingTime]
			if $fileUpdateFlag {return 1}
}
		} elseif [regexp -nocase {\.tex$} $path] {
			Load $path fileContent
			if [regexp {^set fileContentList } $fileContent] {
# store default schedule
				set numberOfSubstitutions 1
				set storeTclPage 1
				StoreDefaultSchedule $repName $path $numberOfSubstitutions $storeTclPage
			} else {
# don't store default schedule
				set numberOfSubstitutions 0
				set storeTclPage 0
			}
		} else {
# store default schedule
#			set numberOfSubstitutions 2
			set numberOfSubstitutions 1	;# added by JFB in 2014-06-15 - 1 is usually enough
			set storeTclPage 1
			StoreDefaultSchedule $repName $path $numberOfSubstitutions $storeTclPage
		}
	} else {
# no tcl page file
		if [file exists $dirName/@schedule.tcl] {
			catch {source $dirName/@schedule.tcl}
		} elseif [regexp -nocase {\.tex$} $path] {
			Load $path fileContent
			if [regexp {^set fileContentList } $fileContent] {
# store default schedule
				set numberOfSubstitutions 1
				set storeTclPage 1
				StoreDefaultSchedule $repName $path $numberOfSubstitutions $storeTclPage
			} else {
# don't store default schedule
				set numberOfSubstitutions 0
				set storeTclPage 0
			}
		} else {
# store default schedule
			set numberOfSubstitutions 2
			set storeTclPage 1
			StoreDefaultSchedule $repName $path $numberOfSubstitutions $storeTclPage
		}
		if ![info exists startingTime] {set startingTime 02:00:00}
#		if ![info exists timePeriod] #
		if {![info exists timePeriod] || [string equal {1} $timePeriod]} {
#			if [file exists $dirName/mirrorHomePage.html] #	;# commented by GJFB on 2022-12-20 - now mirrorHomePage.html may not exist
			if [regexp {About.html$} $path] {	;# added by GJFB on 2022-12-20
#				set timePeriod 1	;# commented by GJFB on 2022-12-20
				set timePeriod [expr 24*60*60]	;# 1 day	;# added by GJFB on 2022-12-20
			} else {
				set timePeriod 0
			}
		}
		if ![info exists numberOfSubstitutions] {set numberOfSubstitutions 2}
		if ![info exists storeTclPage] {set storeTclPage 1}
		return 1
	}
	return 0
}

# TestForTclPageUpdate - end
# ----------------------------------------------------------------------
# ComputeFileUpdateFlag
# added by GJFB on 2023-01-14
# used in TestForTclPageUpdate, MountHTMLPage, Get and post
# filePath is the path of the file candidate to be updated
# timePeriod is the time interval (for example, one day) in seconds within which just one update could be done - 0 means that no update might be done
# return 0 when no update might be done and 1 when an update should be done
# clock format 109306800
# => Tue Jun 19 00:00:00 ART 1973 (base time used by mtime)

proc ComputeFileUpdateFlag {filePath timePeriod {startingTime 02:00:00}} {
	
			if [file exists $filePath] {
				set mtime [file mtime $filePath]
			} else {
				return 1
			}
			if [string equal {infinite} $timePeriod] {return 0}	;# old usage
			if !$timePeriod {return 0}	;# timePeriod is 0
			if [catch {clock scan $startingTime -base 109306800} startingSecond] {
# wrong startingTime
				set startingSecond [clock scan 02:00:00 -base 109306800]	;# 109314000
			}
			set seconds [clock seconds]
			if {[expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} {
# since the last update (mtime), at least one transition time has occured
# where the transition times is = {starting second + n * time period: n = 0, 1, ...}
# old (tcl page) file - the (tcl page) file should be updated
				return 1
			}
			return 0
}

# ComputeFileUpdateFlag - end
# ----------------------------------------------------------------------
# StoreDefaultSchedule
# used in TestForTclPageUpdate and CreateTclPage only

proc StoreDefaultSchedule {repName path numberOfSubstitutions storeTclPage} {
	global homePath
	
	set dirName [file dirname $path]
	if {[regexp -all {/} $repName] != 3 || ![regexp ^$homePath/col/$repName/doc $dirName]} {
# wrong path
# ex: $homePath/col/domainname/hostname/year
# added by GJFB on 2015-08-09
		puts {Content-Type: text/plain}
		puts {}
		puts [StoreLog {alert} {StoreDefaultSchedule} "@schedule.tcl not stored: wrong path $path\n[CallTrace]"]
		return
	}
#	if [file exists $dirName/mirrorHomePage.html] #	;# commented by GJFB on 2022-12-20 - now mirrorHomePage.html may not exist
	if [regexp {About.html$} $path] {	;# added by GJFB on 2022-12-20
# @schedule.tcl required because xxAbout.html is a dynamic page that should be updated at the first click of the day or clicking the 'Update this page' anchor
		set schedule \
{set startingTime 02:00:00
# set timePeriod 0	;# infinite
# set timePeriod 1	;# commented by GJFB on 2022-12-20
set timePeriod [expr 24*60*60]	;# 1 day	;# added by GJFB on 2022-12-20
set numberOfSubstitutions 2	;# value is 1 or 2
set storeTclPage 1	;# value is 0 or 1 (default - enables restricted access, if any)
set storeOldTclPage 0	;# value is 0 or 1}
#		set timePeriod 1
	} else {
		set schedule \
"set startingTime 02:00:00
set timePeriod 0	\;# infinite
# set timePeriod 1	\;# 1 second
# set timePeriod [expr 24*60*60]	\;# 1 day
set numberOfSubstitutions $numberOfSubstitutions	\;# value is 0, 1 or 2
set storeTclPage $storeTclPage	\;# value is 0 or 1 (default - enables restricted access, if any)
set storeOldTclPage 0	\;# value is 0 or 1"
#		set timePeriod 0
	}
	Store schedule $dirName/@schedule.tcl
}

# StoreDefaultSchedule - end
# ----------------------------------------------------------------------
# ProcessBrackets
# a line like
# [join [lrange $titleList 0 2] <BR>]
# must be coded like
# [[join [[lrange $titleList 0 2]] <BR>]]
# to make the difference with Java Script

proc ProcessBrackets {text} {
	regsub -all {\[\[} $text {#!!#} text
	regsub -all {\]\]} $text {#@@#} text
	regsub -all {\[} $text {#!#} text
	regsub -all {\]} $text {#@#} text
	regsub -all {#!!#} $text {[} text
	regsub -all {#@@#} $text {]} text
	return $text
}

# ProcessBrackets - end
# ----------------------------------------------------------------------
# UnProcessBrackets

proc UnProcessBrackets {text} {
	regsub -all {#!!#} $text {[[} text	;# added by GJFB on 2011-09-09
	regsub -all {#@@#} $text {]]} text	;# added by GJFB on 2011-09-09
	regsub -all {#!#} $text {[} text
	regsub -all {#@#} $text {]} text
	return $text
}

# UnProcessBrackets - end
# ----------------------------------------------------------------------
# PutDocumentOnClipboard
# used by Submit and StoreRepository only - (StoreRepository is not used any more)
# rightPSFile values is 0 or 1
# 1 means that the submitted file is a PS file that must be converted into pdf
# in this case nothing is put on the clipboard
# (the converted file will be put directly into the repository later on)
# noFile value is 0 or 1
# 1 means that the file to be put on the clipboard can be captured from the Web
# on input 0 means that there is an attached file
# on output 0 means that that there is a file on the clipboard2
# download value is yes or no (no is not used)
# fileName is used only when noFile is 0 - it is the name of the file that is put on clipboard
# fileName2 is used only when noFile is 1 - it is the name of the file that is put on clipboard independently of the URL code (recalling that an URL might not specify any file name)
# encodingSystem == [encoding system]
# repositoryContentType is returned without change
# example (Submit):
# PutDocumentOnClipboard \
# $noFile $cgi(download) $env(DOCUMENT_ROOT) $cgi(_U_url) $contentType userfile \
# $cgi(filename) $rightPSFile $repositoryContentType $env(ENCODING_SYSTEM)

proc PutDocumentOnClipboard {
	noFile download homePath url mimeContentType userfileName
	fileName rightPSFile repositoryContentType encodingSystem
	{fileName2 {}}
} {

	if $noFile {
# no file
#		if [regexp {copyright} $download] #
#		if [string equal {yes} $download] #
		if {[string equal {yes} $download] && ![string equal {} $url]} {
# GETURL
			set remotePath $url
			if {[llength $remotePath] == 1} {
# valid url
				if [string equal {} $fileName2] {
					set fileName [file tail $remotePath]
				} else {
					set fileName $fileName2	;# added by GJFB on 2022-11-01 (useful when importing file from Google Drive)
				}

				if [string equal {} $fileName] {
# no file to download
					set documentPath {}
					set unzip 0
#					set repositoryContentType2 {}	;# not an external contribution
				} else {
					package require http
					set documentPath $homePath/clipboard2
					file delete -force $documentPath	;# it has been observed that sometimes, at this point, the clipboard2 is not empty
					file mkdir $documentPath
					set unzip [regexp -nocase {\.zip$} $fileName]
					set fileId [open $documentPath/$fileName w]
					if [catch {http::geturl [ConvertURLToHexadecimal $remotePath] -channel $fileId} token] {
						return -code error [list {url not found} $remotePath $token]	;# Unsupported URL type "https"
					}					
					if ![regexp {200 OK} [http::code $token]] {
						close $fileId
						http::cleanup $token
						file delete $documentPath/$fileName
#						puts [SetFont [subst [subst ${url not found}]]]
#						puts [http::code $token]
						LeaveQueue [pid]
						return -code error [list {url not found} $remotePath $token]
					}
					close $fileId
					http::cleanup $token
					set noFile 0
				}
			} else {
# invalid url
				LeaveQueue [pid]
				return -code error [list {url not found} $remotePath]
			}
		} else {
			set documentPath {}
			set unzip 0
#			set repositoryContentType2 {}	;# not an external contribution
		}
	} else {
# a file
		if $rightPSFile {
			set documentPath {}
			set unzip 0
#			set repositoryContentType2 {}	;# not an external contribution
		} else {
			set documentPath $homePath/clipboard2
			file delete -force $documentPath	;# it has been observed that sometimes, at this point, the clipboard2 is not empty
			file mkdir $documentPath

			if [regexp {application/octet-stream|text/plain} $mimeContentType] {
				set fileExtension [file extension $fileName]
				set unzip [expr [string equal -nocase {.zip} $fileExtension] || \
					[string equal -nocase {.rar} $fileExtension]]
			} else {
				set unzip [expr [string equal {application/x-zip} $mimeContentType] || \
					[string equal {application/x-zip-compressed} $mimeContentType] || \
					[string equal {application/zip} $mimeContentType] || \
					[string equal {application/x-rar-compressed} $mimeContentType] || \
					[string equal {application/x-rar} $mimeContentType] || \
					[string equal {application/rar} $mimeContentType]]
			}
			
			upvar $userfileName userfile
			if ![info exists userfile] {set userfile {}}	;# added by GJFB on 2022-11-03 - useful when submitting a package from without using a submission form (see an example in urlib.net/www/2022/06.29.00.06)

if 0 {			
# commented by GJFB on 2023-11-18
			set userfile [string trim $userfile]
# tcl 8.5 doesn't trim '0' character (null character)
# binary scan [string trim abc[binary format c* {0 0 0 0 0}]] c* x
# => 97 98 99 0 0 0 0 0
# tcl 8.6 does trim '0' character (null character)
# binary scan [string trim abc[binary format c* {0 0 0 0 0}]] c* x
# => 97 98 99
} else {
# added by GJFB on 2023-11-18 to successfully run unzip with tcl 8.6 - one cannot trimright zip file in Linux (the last five null characters are used as a end-of-file for unzip), otherwise one gets the unzip error: 'End-of-central-directory signature not found'
			if $unzip {
				set userfile [string trimleft $userfile]
			} else {
				set userfile [string trim $userfile]
			}
}
			regsub -all {&#92;} $fileName {/} fileName	;# &#92; -> /
if 0 {
# empty file are meaningful
			if [string equal {} $userfile] {
#				puts [SetFont [subst [subst ${file not found}]]]
				LeaveQueue [pid]
				return -code error [list {file not found} $fileName]
			}
}
			regsub -all {%20} $fileName { } fileName	;# the browsers don't find files whose names are of the form xx%20xx (in this case the browsers ask for xx xx)
			set fileName [encoding convertto $encodingSystem [file tail $fileName]]	;# solves the accent problem
# STORE userfile
#			Store userfile $documentPath/$fileName binary 0 w	;# doesn't work with .docx files
			Store userfile $documentPath/$fileName binary 1 w	;# no newline option added by GJFB on 2010-11-08 - solves the .docx problem
#			set repositoryContentType2 {}	;# not an external contribution
		}
	}

#	if ![string equal {} $repositoryContentType] {set repositoryContentType2 $repositoryContentType}	;# don't change
#	return [list $noFile $documentPath $unzip $repositoryContentType2]
	return [list $noFile $documentPath $unzip $repositoryContentType]
}

# PutDocumentOnClipboard - end
# ----------------------------------------------------------------------
# CreateCGIArray
# used by CreateMirror and Register
# useful to recover the filled fields after a submit error
# used by MirrorSearch (useful to hide password1 and codedpassword1)
# list value is 0 or 1; 1 means to leave the check box type entry as a list
# (used in the script that performs the administrator page for customizing the submission forms) 

proc CreateCGIArray {{list 0}} {
	global env
	global cgi
	upvar returnInfo returnInfo

	if ![info exists env(CONTENT_LENGTH)] {return} 
	fconfigure stdin -translation binary
	if ![catch {read stdin $env(CONTENT_LENGTH)} query] {
# puts $query
# Store query C:/tmp/bbb binary 0 a
		regsub -all {([^D])%0A} $query {\1%0D%0A} query	;# because of Netscape limitation to code a new line (this is important when there are more than one author)
		foreach {name value} [split $query &=] {
			set fieldName [DecodeURL $name]
			if {[info exists cgi2($fieldName)] && ![string equal {} $cgi2($fieldName)]} {
# Process check box type entry
				lappend cgi2($fieldName) [DecodeURL $value]
# Process check box type entry - end
			} else {
				set cgi2($fieldName) [list [DecodeURL $value]]
			}
		}

		JoinCGIEntries cgi2 1 $list

		array set cgi [array get cgi2]

# puts [array get cgi]
# exit
# set xxx [array get cgi]
# Store xxx C:/Users/gerald.banon/tmp/bbb binary 0 a

		if {[info exists cgi(returnaddress)] && ![string equal {} $cgi(returnaddress)]} {
# puts $cgi(returnaddress)
			append returnInfo &returnaddress=$cgi(returnaddress)	;# used in enUpdateSubmission.html ...
		}
	}
}

# CreateCGIArray - end
# ----------------------------------------------------------------------
# JoinCGIEntries
# used by MakeCGIArray and CreateCGIArray
## aa bb cc -> aa, bb, cc.	(check box type)
# aa bb cc -> aa; bb; cc.	(check box type)
## aa {bb cc}  -> aa, bb cc.	(check box type)
# aa {bb cc}  -> aa; bb cc.	(check box type)
# aa -> aa
# {aa bb cc} -> aa bb cc
# list value is 0 or 1; 1 means to leave the check box type entry as a list
# inverse procedure is TurnIntoList

proc JoinCGIEntries {{varName cgi} {level #0} {list 0}} {
	upvar $level $varName cgi
	foreach index [array names cgi] {
#		if {[string compare filename $index] == 0} {continue}	;# file name may be a list, don't do the following process
		if {!$list && [llength $cgi($index)] > 1} {
# check box type
# aa bb cc or aa {bb cc}
#			set cgi($index) [join $cgi($index) {, }].	;# solving check box type entry
			set cgi($index) [join $cgi($index) {; }].	;# solving check box type entry
		} else {
# aa or {aa bb cc}
			set cgi($index) [join $cgi($index)]
		}
	}
}

# JoinCGIEntries - end
# ----------------------------------------------------------------------
# TurnIntoList
# used by CreateMirror and ProcessReview
# value must not contain #!#
# aa bb; cc dd. -> {aa bb} {cc dd} - (new)
# aa, bb; cc, dd. -> {aa, bb} {cc, dd} - (new)
# aa,bb; cc,dd. -> {aa,bb} {cc,dd} - (new)
# aa bb, cc dd. -> {aa bb} {cc dd}
# aa,bb, cc,dd. -> {aa,bb} {cc,dd}
# inverse procedure is JoinCGIEntries

proc TurnIntoList {value} {
#	regsub -all {, } $value {,} value
#	regsub {\.$} $value {} value	;# drop period
#	return [split $value ,]
	regsub -all {@} $value {#!#} value	;# @ > #!#
	if ![regsub -all {; } $value {@} value] {
		if [regexp {\.$} $value] {
# value must be interpreted as a list
			regsub -all {, } $value {@} value
		}
	}
	regsub {\.$} $value {} value	;# drop period
	set value [split $value @]
	regsub -all {#!#} $value {@} value	;# #!# > @
	return $value
}

# TurnIntoList - end
# ----------------------------------------------------------------------
# ConditionalSet
# example:
# ConditionalSet bgColor body(background-color) #DDDDDD
# ConditionalSet enableUnique cgi(enableunique) yes

proc ConditionalSet {varName1 varName2 defaultValue} {
	upvar $varName1 var1
	upvar $varName2 var2
	if {[info exists var2] && ![string equal {} $var2]} {
		set var1 $var2
	} else {
# don't exist or is empty
		set var1 $defaultValue
	}
	return $var1	;# added by GJFB on 2016-05-28 - used in iconet.com.br/banon/2006/07.02.02.18/cgi/script
}

# ConditionalSet - end 
# ----------------------------------------------------------------------
# ConditionalLappend
# example:
# ConditionalLappend verbList cgi(ibiurl.verblist)
# used in ParseIBIURL only

proc ConditionalLappend {varName1 varName2} {
	upvar $varName1 var1
	upvar $varName2 var2
	if [info exists var2] {
		eval lappend var1 $var2
	} else {
		lappend var1
	}
}

# ConditionalLappend - end 
# ----------------------------------------------------------------------
# CreateHiddenInput
# is used to create return buttons
# abstractFlag value is 0 or 1 (default) - value 0 is used in Submit (see cgi/submit.tcl) - added by GJFB on 2026-07-10

proc CreateHiddenInput {varName {deposit 0} {abstractFlag 1}} {
	global cgi
	upvar $varName var

	if $deposit {
#		set pattern {^password.$|^codedpassword.$|^filename$|^currentpassword$|^deposit$}
		set patternList {password. codedpassword. filename currentpassword deposit}
	} else {
#		set pattern {^password.$|^codedpassword.$|^filename$|^currentpassword$|^codedcurrentpassword$}
		set patternList {password. codedpassword. filename currentpassword codedcurrentpassword administratorpassword}
	}
	set pattern ^[join $patternList {$|^}]$
	foreach field [array names cgi] {
		if {!$abstractFlag && [string equal {_X_abstract} $field]} {continue}	;# added by GJFB on 2026-07-10 to discard the abstract field that may be very large
		if ![regexp $pattern $field] {
			set value $cgi($field)
			regsub -all {"} $value {\&quot;} value	;# "
			append var "\
<INPUT TYPE=HIDDEN NAME=\"$field\" VALUE=\"$value\">
"
		}
	}
}

# CreateHiddenInput - end

# ----------------------------------------------------------------------
# FilterEMailAddress
# example: turns Banon@DPI.INPE.br into Banon@dpi.inpe.br
# see RFC 2822

proc FilterEMailAddress {address} {
	if [regexp {^([^<\s@]+)@([^@\s>]+)$} $address m localPart domainName] {
# address is an e-mail address
		set address $localPart@[string tolower $domainName]
	}
	return $address
}

# FilterEMailAddress - end
# ----------------------------------------------------------------------
# StorePassword
# password must be coded
# used by cgi script (ForcePassword, Register and Submit)
# called by StorePassword2 used by cgi/createNewPassword in iconet.com.br/banon/2009/05.17.20.29
# eMailAddress is the e-mail address of the userName (if any)
# sessionTime value are milliseconds - added by GJFB on 2019-01-16

proc StorePassword {userName password {eMailAddress {}} {sessionTime {}}} {
	global homePath
	global htpasswdPath
	global loCoInRep
	global URLibServiceRepository
	global env	;# for cgi script
	global environmentArray

# puts OK
	set userName [FilterEMailAddress $userName]	;# Banon@DPI.INPE.br -> Banon@dpi.inpe.br

##	catch {exec $htpasswdPath -cbs $homePath/col/$loCoInRep/auxdoc/@passwords.txt $userName $password} message
#	Store htpasswdLine $homePath/col/$loCoInRep/auxdoc/@passwords.txt auto 0 a

	Load $homePath/col/$loCoInRep/auxdoc/@passwords.txt passwords
	set passwordList [split $passwords \n]

	set index [lsearch -regexp $passwordList "^$userName:"]
	set passwordList [lreplace $passwordList $index $index]
	catch {exec $htpasswdPath -nbs $userName [DecodeKey $password]} htpasswdLine
	lappend passwordList $htpasswdLine

	if [info exists env(SERVER_ADMIN)] {
		set administratorEMailAddress $env(SERVER_ADMIN)	;# for web form - after an administrator change Apache should be restarted - at the moment an unpost/post sequence is necessary 
	} else {
		set administratorEMailAddress $environmentArray(spMailEntry)
	}

	regsub {@.*$} $administratorEMailAddress {} administratorUserName	;# banon
## the login of the administrator must not be an e-mail address
#	if {[string compare $administratorUserName $userName] == 0} #
##		set eMailAddress [GetUserData $userName write {e-mailaddress}]	;# doesn't work (userName is not yet part of @passwords.txt)
# puts [list $administratorUserName $userName $administratorEMailAddress $eMailAddress]
#		if [string equal $administratorEMailAddress $eMailAddress] #	;# not safe - an user with name userName may use the administrator e-mail
		if {[string equal $administratorUserName $userName] && [string equal $administratorEMailAddress $eMailAddress]} {
# userName is the administrator name
			set data [Shift $loCoInRep $password]
			Store data $homePath/col/$loCoInRep/auxdoc/xxx binary 1
			set index [lsearch -regexp $passwordList "^administrator:"]
			set passwordList [lreplace $passwordList $index $index]
			catch {exec $htpasswdPath -nbs administrator [DecodeKey $password]} administratorHtpasswdLine
			lappend passwordList $administratorHtpasswdLine
			file delete $homePath/col/$URLibServiceRepository/auxdoc/messageForRegister		;# added by GJFB on 2021-11-16 - messageForRegister is created in post and used in cgi/mirror.tcl
# puts OK
if 0 {
# commented by GJFB on 2014-04-08 - the e-mail address login may already exists and its password should be preserve - useful when changing the administrator name (see also Register)
			regsub {@.*$} $administratorEMailAddress {} administratorUserName
			if [string equal $administratorUserName $userName] {
# login is just a user name
				set index [lsearch -regexp $passwordList "^$eMailAddress:"]
				set passwordList [lreplace $passwordList $index $index]
				catch {exec $htpasswdPath -nbs $eMailAddress [DecodeKey $password]} administratorHtpasswdLine
				lappend passwordList $administratorHtpasswdLine
			} else {
# login is an e-mail address
# redundant code
				set index [lsearch -regexp $passwordList "^$administratorUserName:"]
				set passwordList [lreplace $passwordList $index $index]
				catch {exec $htpasswdPath -nbs $administratorUserName [DecodeKey $password]} administratorHtpasswdLine
				lappend passwordList $administratorHtpasswdLine
			}
}
		}
	#

	set passwords [join $passwordList \n]
	Store passwords $homePath/col/$loCoInRep/auxdoc/@passwords.txt
}

# StorePassword - end
# ----------------------------------------------------------------------
# GetUserData
# entrySearch value is a glob-style pattern
# type value is {}, write or read
# {} means to return the user data anyway
# append value is {}, fullname, fullname2, e-mailaddress, resumeid, orcid, cpf or encryptedpassword 
# full name is used by search.cgi
# encrypted password is used by UpdateRepMetadataRep
# noMatch value is 0 or 1 (1 means no match)
# returns a matching key list
# must not be used with noMatch == 1 with start, unless the
# searchRepository is sourced (see start file)
# Examples:
# GetUserData ba* write {fullname} 1 => Banon (Gerald Jean Francis Banon)
# GetUserData ba* write {fullname2} 1 => Gerald Jean Francis Banon
# GetUserData banon write {e-mailaddress} => banon@iconet.com.br
# GetUserData banon read => banon
# GetUserData banon write {encryptedpassword} => banon:{SHA}3Xt7dOoWDgSd0ShHjgdM5HJUveg=
# GetUserData banon write => banon
# GetUserData * write {encryptedpassword}
# GetUserData * read {encryptedpassword}
# GetUserData banon {} {fullname} => Gerald Jean Francis Banon
# GetUserData banon {} {encryptedpassword} => banon:{SHA}3Xt7dOoWDgSd0ShHjgdM5HJUveg=
# GetUserData banon {} {e-mailaddress} => banon@iconet.com.br
# GetUserData banon@dpi.inpe.br write {cpf} => xxx40655491

proc GetUserData {entrySearch {type {}} {append {}} {noMatch 0}} {
	global homePath
	global loCoInRep
	
	Load $homePath/col/$loCoInRep/auxdoc/@passwords.txt passwords
	if [file exists $homePath/col/$loCoInRep/auxdoc/.userArray.tcl] {
		source $homePath/col/$loCoInRep/auxdoc/.userArray.tcl
	} else {
		return {}
	}

	if $noMatch {
		set pattern [SetNoMatch $entrySearch no no]
	} else {
		set pattern $entrySearch
	}

# Make userNameArray
	set userNameList {}
	foreach line [split $passwords \n] {
		if [regexp {(.*):(.*)} $line m userName encryptedPassword] {
			set userNameList [concat $userNameList [list $userName $encryptedPassword]]
		}
	}
	array set userNameArray $userNameList
# Make userNameArray - end

	set list {}
	foreach userName [lsort [array names userNameArray $pattern]] {
		if [string equal {write} $type] {
# write
			if [info exists userArray($userName,fullname)] {
# write user
				switch -exact $append fullname {
# append full name
					lappend list "$userName ($userArray($userName,fullname))"
				} fullname2 {
# append fullname2
					lappend list $userArray($userName,fullname)
				} resumeid {
# append resumeid
					lappend list $userArray($userName,resumeid)
				} orcid {
# append orcid
					lappend list $userArray($userName,orcid)
				} cpf {
					if [info exists userArray($userName,cpf)] {
# append cpf
						lappend list $userArray($userName,cpf)
					}
				} encryptedpassword {
# append encrypted password
					lappend list $userName:$userNameArray($userName)
				} {} {
# append nothing
					lappend list $userName
				} e-mailaddress {
# append e-mailaddress
					if [info exists userArray($userName,e-mailaddress)] {
						lappend list $userArray($userName,e-mailaddress)
					}
				}
			}
		} elseif {[string equal {read} $type]} {
# read
			switch -exact $append encryptedpassword {
# append encrypted password
				lappend list $userName:$userNameArray($userName)
			} {} {
# append nothing
				lappend list $userName
			} e-mailaddress {
# append e-mailaddress
				if [info exists userArray($userName,e-mailaddress)] {
					lappend list $userArray($userName,e-mailaddress)
				}
			}
		} else {
# empty type
			switch -exact $append fullname {
# append full name
				if [info exists userArray($userName,fullname)] {
					lappend list $userArray($userName,fullname)
				}
			} encryptedpassword {
# append encrypted password
				lappend list $userName:$userNameArray($userName)
			} {} {
# append nothing
			} e-mailaddress {
# append e-mailaddress
				if [info exists userArray($userName,e-mailaddress)] {
					lappend list $userArray($userName,e-mailaddress)
				}
			}
		}
	}
	return $list
}

if 0 {
set homePath "C:/Gerald/URLib 2"
set loCoInRep dpi.inpe.br/banon/1999/01.09.22.14
source cgi/mirrorfind-.tcl
source utilities1.tcl
source $homePath/col/$loCoInRep/auxdoc/.userArray.tcl
source ../../../../../dpi.inpe.br/banon/1999/04.21.17.06/doc/Search.tcl
source utilitiesMirror.tcl
}
if 0 {
# test

	puts [GetUserData ba* write {fullname} 1]
	puts [GetUserData ba* write {fullname2} 1]
	puts [GetUserData banon write {e-mailaddress}]
	puts [GetUserData banon read]
	puts [GetUserData banon write {encryptedpassword}]
	puts [GetUserData * write {encryptedpassword}]
	puts [GetUserData * read {encryptedpassword}]
	puts [GetUserData banon@dpi.inpe.br write {cpf}]
}

# GetUserData - end
# ----------------------------------------------------------------------
# DeleteLogin
# used only by the administrator
# used by cgi script (ForcePassword)

proc DeleteLogin {userName} {
	global homePath
	global loCoInRep
	global env

	set userName [FilterEMailAddress $userName]

	regsub {@.*$} $env(SERVER_ADMIN) {} administratorUserName
	if {[string compare $administratorUserName $userName] == 0} {return}

	Load $homePath/col/$loCoInRep/auxdoc/@passwords.txt passwords
	set passwordList [split $passwords \n]
	set index [lsearch -regexp $passwordList "^$userName:"]
	set passwordList [lreplace $passwordList $index $index]
	set passwords [join $passwordList \n]
	Store passwords $homePath/col/$loCoInRep/auxdoc/@passwords.txt
	if [file exists $homePath/col/$loCoInRep/auxdoc/.userArray.tcl] {
		source $homePath/col/$loCoInRep/auxdoc/.userArray.tcl
	}
	foreach item [array names userArray $userName,*] {
		unset userArray($item)
	}
	StoreArray userArray $homePath/col/$loCoInRep/auxdoc/.userArray.tcl w list array 1
}

# DeleteLogin - end
# ----------------------------------------------------------------------
# MultipleRegsub
# Example: used to drop commas in list:
# set list [MultipleRegsub {[, ]*$} $list {}]

proc MultipleRegsub {pattern1 list pattern2} {
	set list2 {}
	foreach item $list {
		regsub $pattern1 $item $pattern2 item
		lappend list2 $item
	}
	return $list2
}

# MultipleRegsub - end
# ----------------------------------------------------------------------
# ProcessMultipleLineField
# used in Submit and ReloadDisplayText only
# appends or updates the list called fieldListName

# fieldListName is the name of a list of the type: {%A {{Aa Bb} {Cc Dd}}} {%T {Tt tt}}

# fieldName value is for example %@resumeid
# example:
# ProcessMultipleLineField metadataEntryList2 $attributeReferName [join $fieldValue \n]
# attributeReferName == %@resumeid
# fieldValue == 8JMKD3MGP5W/3C9EMTE
# metadataEntryList2 before:
# {%@mirrorrepository iconet.com.br/banon/2006/11.26.21.31} {%8 {}} {%N {}} {%T {Testando formulário de submissão}} {%@electronicmailaddress {}} {%@secondarytype {PRE PI}} {%@archivingpolicy {}} {%@usergroup banon} {%@group DPI-OBT-INPE-MCTI-GOV-BR} {%@e-mailaddress {}} {%3 {}} {%@copyholder {}} {%@secondarykey INPE--PRE/} {%@secondarymark {B2_BIOTECNOLOGIA B2_CIÊNCIAS_BIOLÓGICAS_I B3_CIÊNCIAS_BIOLÓGICAS_III B1_MEDICINA_I B1_MEDICINA_II B1_MEDICINA_VETERINÁRIA A2_ZOOTECNIA_/_RECURSOS_PESQUEIROS}} {%U {}} {%@issn 0300-9858} {%2 urlib.net/www/2013/01.20.23.46.36} {%@affiliation {{Instituto Nacional de Pesquisas Espaciais (INPE)}}} {%@project {}} {%B {Veterinary Pathology}} {%@versiontype publisher} {%P {}} {%4 urlib.net/www/2013/01.20.23.46} {%@documentstage {not transferred}} {%D 2012} {%V 92} {%@doi {}} {%A {{Banon, Gerald Jean Francis,}}} {%@rightsholder {}} {%@area SRE} {%@group DPI-OBT-INPE-MCTI-GOV-BR}
# metadataEntryList2 after:
# {%@mirrorrepository iconet.com.br/banon/2006/11.26.21.31} {%8 {}} {%N {}} {%T {Testando formulário de submissão}} {%@electronicmailaddress {}} {%@secondarytype {PRE PI}} {%@archivingpolicy {}} {%@usergroup banon} {%@group DPI-OBT-INPE-MCTI-GOV-BR} {%@e-mailaddress {}} {%3 {}} {%@copyholder {}} {%@secondarykey INPE--PRE/} {%@secondarymark {B2_BIOTECNOLOGIA B2_CIÊNCIAS_BIOLÓGICAS_I B3_CIÊNCIAS_BIOLÓGICAS_III B1_MEDICINA_I B1_MEDICINA_II B1_MEDICINA_VETERINÁRIA A2_ZOOTECNIA_/_RECURSOS_PESQUEIROS}} {%U {}} {%@issn 0300-9858} {%2 urlib.net/www/2013/01.20.23.46.36} {%@affiliation {{Instituto Nacional de Pesquisas Espaciais (INPE)}}} {%@project {}} {%B {Veterinary Pathology}} {%@versiontype publisher} {%P {}} {%4 urlib.net/www/2013/01.20.23.46} {%@documentstage {not transferred}} {%D 2012} {%V 92} {%@doi {}} {%A {{Banon, Gerald Jean Francis,}}} {%@rightsholder {}} {%@area SRE} {%@group DPI-OBT-INPE-MCTI-GOV-BR} {%@resumeid 8JMKD3MGP5W/3C9EMTE}

# processType value is 0 or 1
# 0 means to append
# 1 means to update, i.e.,
# set the value of the field named fieldName to fieldValue
# if the fieldName already exists, then it updated, otherwise it is added
# if the newFieldValue is empty the field is deleted

proc ProcessMultipleLineField {fieldListName fieldName fieldValue {processType 0}} {
	upvar $fieldListName fieldList
if $processType {
# update	
	array set metadataEntryArray [join $fieldList]
	if [string equal {} $fieldValue] {
		if [info exists metadataEntryArray($fieldName)] {unset metadataEntryArray($fieldName)}
	} else {
		set metadataEntryArray($fieldName) [split $fieldValue \n]
	}
	set fieldList {}
	foreach {name value} [array get metadataEntryArray] {
		lappend fieldList [list $name $value]
	}
} else {
# append
	lappend fieldList [list $fieldName [split $fieldValue \n]]
}
}

# ProcessMultipleLineField - end
# ----------------------------------------------------------------------
# ProcessAuthorField
# used in Submit and ReloadDisplayText only
# fieldName value is for example %A
# nothing is done when fieldValue is empty

proc ProcessAuthorField {fieldListName fieldName fieldValue} {
	global multipleLineReferFieldNamePatternForCreator
	upvar $fieldListName fieldList
	
	set flag [regexp $multipleLineReferFieldNamePatternForCreator $fieldName]
	if $flag {
		regsub -all "\n+" [string trim $fieldValue \n] "\n" fieldValue	;# drop blank line in creator field
	} else {
		set fieldValue [string trimright $fieldValue \n]	;# otherwise the field value increases with trailing blank line after successive updates
	}
	foreach line [split $fieldValue \n] {
		if [regexp {&\w{2,6};} $line] {
# there is some HTML code not defined above
			lappend fieldValueList $line
		} else { 	
# Detect more than one author per line
			set line [string trimright $line] ;# drop trailing blank
			if [regexp {^%A} $fieldName] {
				if [regsub -all { and } $line {, } line] {
					regsub -all {,} $line {;} line
				}
				if {[regsub -all {,[^$]} $line {;} line2] > 1} {set line $line2}
			}
# Detect more than one author per line - end
			regsub { *;$} $line {} line	;# drop trailing semicolon
			if [string equal {} $line] {
#				lappend fieldList $fieldName
#				lappend fieldList [list $fieldName {}]	;# commented in 2008-11-06
				lappend fieldValueList {}
			} else {
				foreach name [split $line {;}] {
					if [regexp {^%A} $fieldName] {
						if ![regexp {,$} $name] {
# not an institution name
							regsub -all { *\([^\)]*\)} $name {} name	;# drop string within parenthesis, example: (orientador)
						}
					}
# the if below is redundant because ProcessAuthorField is always called with fieldName == %A or with a fieldName corresponding to an author field name (see authorFieldNameList) - GJFB on 2013-01-20
#					if ![regexp {^%O|^%1|^%@resumeid|^%@group|^%@affiliation|^%@electronicmailaddress} $fieldName] #
						if [regexp {,} $name] {
							set name [string trimright $name {, }] ;# drop trailing commas
							set name $name,	;# add trailing comma
						}
#					#
# set xxx --$name--
# Store xxx C:/Users/gerald.banon/tmp/bbb auto 0 a
#					lappend fieldList [string trim "$fieldName $name"]	;# trim is useful when fieldName is empty
# puts 1-$name
					if $flag {set name [FormatName $name]}
# puts 2-$name
#					lappend fieldList [list $fieldName $name]
					lappend fieldValueList $name
				}
			}
		}
	}
	if [info exists fieldValueList] {
		lappend fieldList [list $fieldName $fieldValueList]
	}
}

# ProcessAuthorField - end
# ----------------------------------------------------------------------
# FormatName
# Formats an author name
# Gerald Jean Francis Banon -> Banon, Gerald Jean Francis,
# Gerald Jean Francis Banon (supervisor) -> Banon, Gerald Jean Francis (supervisor),
# Banon, Gerald Jean Francis -> Banon, Gerald Jean Francis,
# Banon, Gerald Jean Francis, -> Banon, Gerald Jean Francis,
# Instituto de Pesquisas, -> Instituto de Pesquisas,
# Instituto de Pesquisas (Brasil), -> Instituto de Pesquisas (Brasil),
# Instituto de Pesquisas, (Brasil) -> Instituto de Pesquisas (Brasil),
# Instituto de Pesquisas, (Brasil), -> Instituto de Pesquisas (Brasil),
# used in LoadMatadata

# see also ParseFullName in iconet.com.br/banon/2001/11.24.08.30 

proc FormatName {string} {
# set xxx $name
# Store xxx C:/tmp/bbb.txt auto 0 a
#	set string [string trim $string]	;# commented by GJFB on 2013-05-28
	regsub -all {\s+} $string { } string	;# added by GJFB on 2013-05-28 - drop all sorts of blanks space, including the blank space H2 coded a0 - see x in binary scan { } H2 x
	if [regexp {(.*?)(\s*\(.*\)\s*,?)$} $string m name attribute] {
		if {[regsub {,$} $attribute {} attribute] && ![regexp {,$} $name]} {
			set name $name,
		}
	} else {
# no attribute
		set name $string
		set attribute {}
	}
	switch -regexp -- $name \
	{,} {
# name with a comma
		regsub {,$} $name {} newName
#		regsub -all { +,} $newName {,} newName
		regsub -all {\s+,} $newName {,} newName
		regsub -all {,([^ ])} $newName {, \1} newName
##		regsub -all {\.([^ ,])} $newName {. \1} newName	;# commented by GJFB on 2012-02-27 - Banon 1945.05 -> Banon 1945. 05
#		regsub -all {\.([^ ,\d])} $newName {. \1} newName	;# added by GJFB on 2012-02-27 - decimal number must be preserved - Banon, G.J.F. -> Banon, G. J. F. - Banon 1945.05 -> Banon 1945.05
		regsub -all {\.([^ ,])} $newName {. \1} newName
	} \
	default {
# name without a comma
# find the index of the first word of the last name, e.g., von Beethoven
		set lastNameIndex [expr [llength $name] - 1]
		if [regexp {^(Junior|Neto|Filho|Mini)$} [lindex $name end]] {
			incr lastNameIndex -1
		}
		set i 0
		foreach word $name {
			if [regexp {von|Jr} $word] {
				set lastNameIndex $i
				break
			}
			incr i
		}
		set firstNameIndex [expr $lastNameIndex - 1]
		set lastName [lrange $name $lastNameIndex end]
		set firstNames [lrange $name 0 $firstNameIndex]
		if [string equal {} $firstNames] {
# there is no first name
			set newName $lastName
		} else {
# there is a first name
			set newName [concat $lastName, $firstNames]
		}
		regsub -all {\.([^ ])} $newName {. \1} newName
	}
	return $newName$attribute,
}

# puts [FormatName {Gilberto Câmara Neto}]
# puts [FormatName {João da Silva}]
# => Silva, João da,
# puts [FormatName {Gerald Jean Francis Banon}]
# => Banon, Gerald Jean Francis,
# puts [FormatName {Banon, Gerald Jean Francis}]
# => Banon, Gerald Jean Francis,
# puts [FormatName {Banon, Gerald J. F.}]
# => Banon, Gerald J. F.,
# puts [FormatName {Banon, G.J.F.}]
# => Banon, G. J. F.,
# puts [FormatName {Banon, Gerald Jean Francis,}]
# => Banon, Gerald Jean Francis,
# puts [FormatName {Instituto de Pesquisas,}]
# => Instituto de Pesquisas,
# puts [FormatName {Watch Guard Technologies, INC.}]
# => Watch Guard Technologies, INC.,
# puts [FormatName {Watch Guard Technologies, INC.,}]
# => Watch Guard Technologies, INC.,
# puts [FormatName {Ludwig von Beethoven}]
# => von Beethoven, Ludwig,
# puts [FormatName {Gerald Jean Francis Banon (supervisor)}]
# => Banon, Gerald Jean Francis (supervisor),
# puts [FormatName {Instituto de Pesquisas, (Brasil)}]
# => Instituto de Pesquisas (Brasil),
# puts [FormatName {Instituto de Pesquisas (Brasil),}]
# => Instituto de Pesquisas (Brasil),
# puts [FormatName {Instituto de Pesquisas, (Brasil),}]
# => Instituto de Pesquisas (Brasil),

# FormatName - end
# ----------------------------------------------------------------------
# ProcessTitleField
# used in Submit and ReloadDisplayText
# drops trailing period

proc ProcessTitleField {fieldListName fieldName fieldValue} {
	upvar $fieldListName fieldList
	set line $fieldValue
	if [string equal {} $line] {return}
	regsub { *[\.;,]*$} $line {} line	;# drop trailing punctuation
	lappend fieldList [list $fieldName $line]
}

# ProcessTitleField - end
# ----------------------------------------------------------------------
# ProcessKeywordsField
# used in Submit and ReloadDisplayText
# changes ; into , and adds a period

proc ProcessKeywordsField {fieldListName fieldName fieldValue} {
	upvar $fieldListName fieldList
	set line $fieldValue
	if {[string compare {} $line] == 0} {return}
	set line [join [split $line \n] {, }]
	regsub { *[\.;,]*$} $line {} line	;# drop trailing punctuation
	regsub -all {;} $line {,} line	;# ; -> ,
#	if {[string compare {} $line] != 0} {set line $line.}	;# add a period
	lappend fieldList [list $fieldName $line.]	;# add a period
}

# ProcessKeywordsField - end
# ----------------------------------------------------------------------
# ProcessAbstractField
# used in Submit and ReloadDisplayText
# changes '.Abstract:In' into '. ABSTRACT: In' and adds a period

proc ProcessAbstractField {fieldListName fieldName fieldValue} {
	upvar $fieldListName fieldList
	set line $fieldValue
	if [string equal {} $line] {return}
	regsub { *[\.;,]*$} $line {} line	;# drop trailing punctuation
	regsub -nocase { *ABSTRACT: *} $line { ABSTRACT: } line	;# .Abstract:In -> . ABSTRACT: In
	regsub -nocase { *RESUMO: *} $line { RESUMO: } line	;# .Resumo:EM -> . RESUMO: EM
	set line [string trimleft $line]
	
# set xxx $line
# Store xxx C:/tmp/bbb.txt auto 0 a
# => 11. "22". 33\ 44. ($\mu$) ($w$-operator)

# set xxx [list $fieldName $line.]
# Store xxx C:/tmp/bbb.txt auto 0 a
# => %X {11. "22". 33\ 44. ($\mu$) ($w$-operator).}  <<< 'split' is missing

# set xxx "$fieldName [split $line.]"
# Store xxx C:/tmp/bbb.txt auto 0 a
# => %X {11. {"22".} 33\\ 44. {($\mu$)} {($w$-operator).}}  <<< one must use 'split' to solve an error like 'can't read "referenceType": no such variable' when the abstract contains a backslash followed by a newline as in the 4 lines below:
# 11.
# "22".
# 33\
# 44.

#	lappend fieldList [list $fieldName $line.]	;# add a period - commented by GJFB on 2023-05-14 (see example above)
#	lappend fieldList [list $fieldName [split $line.]]	;# add a period - added by GJFB on 2023-05-14 (see example above) - because of the added 'split', an added 'join' has been required in ConvertListFormatToReferFormat - commented by GJFB on 2024-10-19
	set newFieldValue [split $line.]	;# add a period - added by GJFB on 2023-05-14 (see example above)
	lappend fieldList [list $fieldName $newFieldValue]
	return $newFieldValue	;# added by GJFB on 2024-10-19 because of the added 'split', an added 'join' has been required in Submit
}

# ProcessAbstractField - end
# ----------------------------------------------------------------------
# ClearField
# deletes the characters ˜‡‰ and the unrecognized characters ()
# these characters appear when scanning text and
# are not accepted during an oai validation 
# used in Submit and not in ReloadDisplayText

proc ClearField {fieldValue} {
	binary scan ˜‡‰ c* numberList
	set pattern ^[join $numberList {$|^}]$
	set numberList {-97 -98 -99 -100 -101 -102 -103 -104 -105 -106 -107 -108 -109 -110 -111 -112 -113 -114 -115 -116 -117 -118 -119 -120 -121 -122 -123 -124 -125 -126 -127 -128 -129 0 1 2 3 4 5 6 7 8 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31}
	set pattern2 ^[join $numberList {$|^}]$
	set fieldValue2 {}
	foreach c [split $fieldValue {}] {
		binary scan $c c* number
		if [regexp -- $pattern $number] {
			if ![regexp -- $c [binary format c* $number]] {continue}
		}
		if [regexp -- $pattern2 $number] {continue}
		append fieldValue2 $c
	}
	return $fieldValue2
}

# ClearField - end
# ----------------------------------------------------------------------
# Substitute
# Juliana's work

proc Substitute {string} {
	upvar cgi cgi
	upvar retrieve retrieve
	if ![catch {subst $string} output] {return $output}
}

# Substitute - end
# ----------------------------------------------------------------------
# StoreArray
# Store an array or a list named varName into a file named fileName

# inputFormat value is list, listforarray, unsortedlist or array - default is array
# inputFormat is meanful just when outputFormat value is list
# list means that varName must be treated as a list name
# listforarray means that varName must be treated as a list name, and has the form as a list returned by array get
# array means that varName must be treated as an array name

# outputFormat value is list or array - default is array - with list the file begins with the tcl command array set 
# list means that the array is defined in the file through the command array set (if inputFormat value is array)
# list means that the list is defined in the file through the command set (if inputFormat value is list or listforarray)
# array means that the array is defined repeatedly through the command set

# examples:
# StoreArray repArray $repArrayPath w list
# StoreArray sublista_cpf lista_cpf_todos_2010.tcl w list list
# StoreArray deletedRecordList $col/$loCoInRep/doc/@deletedRecordList.tcl w list listforarray 1
# StoreArray lista_cpf lista_cpf.tcl w list unsortedlist

# preFlag value is 0 or 1, 1 means to add the tags <PRE> and </PRE>

# comparisonCriteria is none (no comparison), ascii or dictionary - used with:
# list outputFormat and array inputFormat or
# list outputFormat and listforarray inputFormat

proc StoreArray {
	varName fileName {option {w}} {outputFormat {array}} 
	{inputFormat {array}} {level {#0}} {varName2 {}} {preFlag 0}
	{comparisonCriteria ascii}
} {
	global homePath
	
	upvar $level $varName var
	
	if {[info exists homePath] && [file exists $homePath/readOnlySite]} {return}
	if [catch {open $fileName $option} fileId] {
		puts stderr $fileId
	} else {
		fconfigure $fileId -buffersize 262144
		if $preFlag {puts $fileId {# <PRE>}}
		if {$outputFormat == "list"} {
# list outputFormat
			if {$inputFormat == "list"} {
# list outputFormat - list inputFormat
#				puts $fileId [list set $varName \n\t[join [lsort $var] \n\t]\n] ;# commented by GJFB on 2011-02-08 - doesn't work when list items are lists
#				puts $fileId [list set $varName $var]	;# no sorting
				set dataSet {}
				foreach item $var {
					lappend dataSet [list $item]
				}
				puts $fileId [list set $varName \n\t[join [lsort $dataSet] \n\t]\n]
			} elseif {$inputFormat == "listforarray"} {
# list outputFormat - listforarray inputFormat
# option added by GJFB on 2011-02-08
				set dataSet {}
				foreach {input output} $var {
					lappend dataSet [list $input $output]
				}
if 0 {
# commented by GJFB on 2020-07-29
				if [string equal {} $varName2] {
					puts $fileId [list set $varName \n\t[join [lsort -$comparisonCriteria -index 0 $dataSet] \n\t]\n]
				} else {
					puts $fileId [list set $varName2 \n\t[join [lsort -$comparisonCriteria -index 0 $dataSet] \n\t]\n]
				}
} else {
# added by GJFB on 2020-07-29 to introduce the option none (no comparison)
				if [string equal {none} $comparisonCriteria] {
					set dataSet2 [join $dataSet \n\t]
				} else {
					set dataSet2 [join [lsort -$comparisonCriteria -index 0 $dataSet] \n\t]
				}
				if [string equal {} $varName2] {
					puts $fileId [list set $varName \n\t$dataSet2\n]
				} else {
					puts $fileId [list set $varName2 \n\t$dataSet2\n]
				}
}
			} elseif {$inputFormat == "unsortedlist"} {
# list outputFormat - unsortedlist inputFormat
# option added by GJFB on 2011-11-23
				set dataSet {}
				foreach item $var {
					lappend dataSet [list $item]
				}
				puts $fileId [list set $varName \n\t[join $dataSet \n\t]\n]
			} else {
# list outputFormat - array inputFormat
				set dataSet {}
				foreach {input output} [array get var] {
					lappend dataSet [list $input $output]
				}
				if [string equal {} $varName2] {
#					puts $fileId [list array set $varName [array get var]]
					puts $fileId [list array set $varName \n\t[join [lsort -$comparisonCriteria -index 0 $dataSet] \n\t]\n]
				} else {
#					puts $fileId [list array set $varName2 [array get var]]
					puts $fileId [list array set $varName2 \n\t[join [lsort -$comparisonCriteria -index 0 $dataSet] \n\t]\n]
				}
			}
		} else {
# array outputFormat
			set fileContent ""
			foreach {index value} [array get var] {
				lappend fileContent [list set ${varName}($index) $value]
			} 
			puts $fileId [join $fileContent \n]
# puts [join $fileContent \n]
		}
		if $preFlag {puts $fileId {# </PRE>}}
		close $fileId
	}
}

if 0 {
# list
set list {{a b} {1 2} {c d} {3 4}}
StoreArray list c:/tmp/list.tcl w list list 1
# =>
set list {
	{1 2}
	{3 4}
	{a b}
	{c d}
}
StoreArray list c:/tmp/list.tcl w list listforarray 1
# =>
set list {
	{a b} {1 2}
	{c d} {3 4}
}

# array
array set array $list
StoreArray array c:/tmp/array.tcl w list array 1
# =>
array set array {
	{a b} {1 2}
	{c d} {3 4}
}
StoreArray array c:/tmp/array.tcl w array array 1
StoreArray array c:/tmp/array.tcl w array list 1
# both =>
set {array(c d)} {3 4}
set {array(a b)} {1 2}
}

# StoreArray - end
# ----------------------------------------------------------------------
# SourceWithBackup
# example: SourceWithBackup $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl localCollectionPasswordArray 1
# sources the most recent of:
# $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl and
# $col/$loBiMiRep/auxdoc/localCollectionPasswordArrayBackup.tcl 
# level value is #0 or 1

proc SourceWithBackup {filePath arrayName {level {#0}}} {
	upvar $level $arrayName $arrayName
	
if 0 {
# commented by GJFB on 2020-06-17 - has never been useful
	set backupPath [file rootname $filePath]Backup[file extension $filePath]
	if [file exists $filePath] {
		set mtime [file mtime $filePath]
	} else {
		set mtime 0
	}
	if [file exists $backupPath] {
		set backupMtime [file mtime $backupPath]
	} else {
		set backupMtime 0
	}
	if {[string compare $mtime $backupMtime] == -1} {
# mtime < backupMtime
		source $backupPath
	} else {
# mtime >= backupMtime
		source $filePath
	}
} else {
#	if [catch {source $filePath}] #	;# commented by GJFB on 2025-08-23
	Load $filePath fileContent	;# added by GJFB on 2025-08-23
	if {[string equal {} $fileContent] || [catch {source $filePath}]} {	;# added by GJFB on 2025-08-23
# filePath is corrupted - use the backupPath
		set backupPath [file rootname $filePath]Backup[file extension $filePath]
		source $backupPath
		set log "the file $filePath is corrupted,\nthe file $backupPath was sourced instead"
		StoreLog {alert} {SourceWithBackup} $log	;# added by GJFB on 2018-05-15
	}
}

}

# SourceWithBackup - end
# ----------------------------------------------------------------------
# StoreArrayWithBackup
# used in StartService
# level value is #0 or 1

proc StoreArrayWithBackup {
	arrayName fileName {option {w}} {outputFormat {array}}
	{inputFormat {array}} {level {#0}} {arrayName2 {}}
} {
	upvar $level $arrayName $arrayName

# if [string equal environmentArray $arrayName] {
#	puts --$environmentArray(domainName)--
#	puts [CallTrace]
# }
	
if 0 {
# commented by GJFB on 2020-06-17 - has never been useful
	set backupName [file rootname $fileName]Backup[file extension $fileName]
	StoreArray $arrayName $backupName $option $outputFormat $inputFormat $level $arrayName2	;# backup - if this store fails because the computer stops, file with fileName remains unchanged
	file copy -force $backupName $fileName	;# if this copy fails because the computer stops, file with backupName can be used as backup
} else {	
# added by GJFB on 2020-06-17
	StoreArray $arrayName $fileName $option $outputFormat $inputFormat $level $arrayName2
	set backupName [file rootname $fileName]Backup[file extension $fileName]	;# update backupName
#	if [catch {source $fileName}] #	;# commented by GJFB on 2024-02-25
#	if {[catch {source $fileName}] || [llength [array names $arrayName]] < 30} #	;# added by GJFB on 2024-02-25 - the number of entries of environmentArray or of other arrays should be greater than 30, otherwise doesn't do the backup action - commented by GJFB on 2025-08-23 - doesn't work when the file called fileName is empty (because, for some reason, the above StoreArray fails) and arrayName is OK
	Load $fileName fileContent	;# added by GJFB on 2025-08-23
	if {[string equal {} $fileContent] || [catch {source $fileName}] || [llength [array names $arrayName]] < 30} {	;# added by GJFB on 2025-08-23 - required when StoreArray fails
# fileName is corrupted - preserve the backupName
		set log "the file $fileName is corrupted,\nthe file $backupName was preserved"
		StoreLog {alert} {StoreArrayWithBackup} $log	;# added by GJFB on 2018-05-15
		return
	}
	StoreArray $arrayName $backupName $option $outputFormat $inputFormat $level $arrayName2
}

}

# StoreArrayWithBackup - end
# ----------------------------------------------------------------------
# ReplicateTwice
# ReplicateTwice {a b} => a a b b

proc ReplicateTwice {list} {
	set list2 {}
	foreach item $list {lappend list2 $item $item}
	return [join $list2]
}

# ReplicateTwice - end
# ----------------------------------------------------------------------
# ReplicateTwice2
# ReplicateTwice2 {a b} => {a a} {b b}

proc ReplicateTwice2 {list} {
	set list2 {}
	foreach item $list {lappend list2 [list [list $item $item]]}
	return [join $list2]
}

# ReplicateTwice2 - end
# ----------------------------------------------------------------------
# DeleteItem2
# DeleteItem2 {{a1 a2} {b1 b2} {c1 c2}} b2 => {{a1 a2} {c1 c2}}
# DeleteItem2 {{a1 a2} {b1 b2} {c1 c2}} {} => {a1 a2} {b1 b2} {c1 c2}}
# used in some displayControl.tcl

proc DeleteItem2 {list item} {
	set list2 {}
	foreach item2 $list {
		set last [lindex $item2 end]
		if [string equal $last $item] {continue}
		lappend list2 $item2
	}
	return $list2
}

# DeleteItem2 - end
# ----------------------------------------------------------------------
# AandNotB
# returns the list A and not B
# where A and B are two lists
# here, lists can be seen as set

proc AandNotB {A B} {
	set list {}
	foreach a $A {
		if {[lsearch -exact $B $a] == -1} {
# a is not in B
			lappend list $a
		}
	}
	return $list
}

# AandNotB - end
# ----------------------------------------------------------------------
# ReturnAuthorLogin
# used in displayControl.tcl
# example: ReturnAuthorLogin $userGroup userNameList(Thesis)
# returns for example: {banon {update by the author}}

# not used
proc ReturnAuthorLogin2 {list varName} {
	upvar $varName userNameList
	upvar advancedUser advancedUser
	if {[lsearch $list $advancedUser] == -1} {
		set list1 [concat $advancedUser $list]	;# the advanced user might not be in the user group (this happen when the advanced user was forced by the administrator)
	} else {
		set list1 $list
	}
	set userGroup {}	;# used in subst $userNameList below
	array set userNameTable [subst $userNameList]
	set list2 [array names userNameTable]
#	set authorLogin [lindex [AandNotB $list $list2] 0]	;# pick the first
	set authorLogin [lindex [AandNotB $list1 $list2] 0]	;# pick the first
	if [string equal $advancedUser $authorLogin] {
		return [list [list {don't transfer} {update by the author}]]
	} else {
		return [list [list $authorLogin {update by the author}]]
	}
}

# ReturnAuthorLogin - end
# ----------------------------------------------------------------------
# Help
# used in displayControl.tcl and Search (cgi/search.tcl - search frame) ...
# instructionType is for example Affiliation
# fieldName (optional - default is %A); its value is for example %E or %K

proc Help {instructionType {fieldName {%A}}} {
	global env
	global localSite	;# set in CreateMirror or in Search
	global display
	global language
	
	upvar referenceType referenceType
	upvar languageRep1 languageRep1
	upvar languageRep2 languageRep2
	upvar firstLanguageRep firstLanguageRep
	upvar submissionFormRep submissionFormRep
	upvar submissionFormLanguage submissionFormLanguage
	upvar submissionFormLanguageRep submissionFormLanguageRep
	upvar restrictedSubmission restrictedSubmission
	upvar update update
	upvar submissionType submissionType	;# set in CreateMirror or Search
	upvar displayTable displayTable	;# added by GJFB on 2021-08-24

# http
	set http http[expr [info exists env(HTTPS)]?{s}:{}]
# set http http

	if {[string equal {Password1} $instructionType] && ($restrictedSubmission || $update)} {return}	;# this help is just for submission (furthermore, it doesn't work at update because it is not consistent with the JavaScript command document.write since the Help return contains quotation marks) 
	if [info exists referenceType] {
		regsub -all { } $referenceType {+} referenceType2	;# Conference Proceedings -> Conference+Proceedings 
		set referenceTypeQuery "&referencetype=$referenceType2"
	} else {
		set referenceTypeQuery {}
	}
	if [info exists displayTable] {
		set fieldType [lindex $displayTable($referenceType,$fieldName) 0]	;# added by GJFB on 2021-08-24 - fieldType is used for keywords intructions only, when $fieldName is %K
		return "<A class=green HREF=$http://$localSite/col/$env(LOBIMIREP)/doc/mirror.cgi/FillingInstructions?instructiontype=$instructionType&fieldname=$fieldName$referenceTypeQuery&languagebutton=$language&languagerep1=$languageRep1&languagerep2=$languageRep2&firstlanguagerep=$firstLanguageRep&submissionformrep=$submissionFormRep&submissionformlanguage=$submissionFormLanguage&submissionformlanguagerep=$submissionFormLanguageRep&submissiontype=$submissionType&fieldtype=$fieldType ONCLICK=\"window.open('', '${display}___instructions', 'width=560,height=150,scrollbars=yes,menubar=no,resizable=yes,toolbar=no')\" TARGET=${display}___instructions>(?)</A>"	;# similar code in CreateMirror (see append updateMenu) - added by GJFB on 2021-08-24
	} else {
#		return "<A class=green HREF=$http://$localSite/col/$env(LOBIMIREP)/doc/mirror.cgi/FillingInstructions?instructiontype=$instructionType&fieldname=$fieldName$referenceTypeQuery&languagebutton=$language&languagerep1=$languageRep1&languagerep2=$languageRep2&firstlanguagerep=$firstLanguageRep&submissionformrep=$submissionFormRep&submissionformlanguage=$submissionFormLanguage&submissionformlanguagerep=$submissionFormLanguageRep ONCLICK=\"window.open('', '${display}___instructions', 'width=560,height=150,scrollbars=yes,menubar=no,resizable=yes,toolbar=no')\" TARGET=${display}___instructions>(?)</A>"
		return "<A class=green HREF=$http://$localSite/col/$env(LOBIMIREP)/doc/mirror.cgi/FillingInstructions?instructiontype=$instructionType&fieldname=$fieldName$referenceTypeQuery&languagebutton=$language&languagerep1=$languageRep1&languagerep2=$languageRep2&firstlanguagerep=$firstLanguageRep&submissionformrep=$submissionFormRep&submissionformlanguage=$submissionFormLanguage&submissionformlanguagerep=$submissionFormLanguageRep&submissiontype=$submissionType ONCLICK=\"window.open('', '${display}___instructions', 'width=560,height=150,scrollbars=yes,menubar=no,resizable=yes,toolbar=no')\" TARGET=${display}___instructions>(?)</A>"	;# similar code in CreateMirror (see append updateMenu)
	}
}

# Help - end
# ----------------------------------------------------------------------
# CreateWebLanguageTable

proc CreateWebLanguageTable {} {
	set languageTable(English) en
	set languageTable(Português) pt-BR
	return [array get languageTable]
}

# CreateWebLanguageTable - end
# ----------------------------------------------------------------------
# FindMetadataRepositories
# uses GetMetadataRepositories to find the metadata repositories within all the selected sites
## must be used only by cgi scripts (only - because of env) when siteList is empty (not tested when not running a cgi-script)
# used by CreateMirror (Register), Submit, ReviewAssignment and MountHTMLPage among others
# returnMessage values are 0 or 1
# 1 means to return "nothing found" message if searchResultList is empty after the search
# 0 means to return the searchResultList value any way
# codedPassword value is the administrator write coded password or empty
# if the password is correct then the hidden repositories as well are searched
# accent and case values are yes or no
# format value is 0, 1, 2, 3 or 4 (see GetMetadataRepositories)
# 0 means that the output format is
# {rep-i rep-i ...}
# 1 means that the output format is
# {site rep-i} {site rep-i} ... WHERE site is actually serverAddress (ex: {gjfb.home 19050})
## setGlobalVariables - useful when FindMetadataRepositories is called from outside the URLibService
## not used
# timeOut maximum waiting time in milliseconds - set only in CreateOptionListForCopyright (CreateOptionListForCopyright is called in displayControl.tcl when using Misc form)
# example:
# set siteMetadataRepList [FindMetadataRepositories $query 0 $siteList $codedPassword no no 1 0 $timeOut]	;# {site rep-i} {site rep-i} ...

proc FindMetadataRepositories {
	query {returnMessage 1} {siteList {}}
	{codedPassword {}} {accent no} {case no} {format 0} {setGlobalVariables 0}
	{timeOut 999999}
} {
	global env
	global environmentArray
	global loBiMiRep
	global loCoInRep	;# used in MultipleSubmit
	global homePath	;# used in MultipleSubmit
	global serverAddress	;# used in MultipleSubmit
	global serverAddressWithIP	;# used in MultipleSubmit
	global searchResultList	;# used in MultipleSubmit
	global numberOfSatisfiedQueries	;# set in this procedure and used in RetornarResultadoDaBusca (see dpi.inpe.br/lise/2008/05.08.14.01)

# set xxx [CallTrace]
# Store xxx C:/tmp/bbb.txt binary 0 a

if $setGlobalVariables {
# not used
# useful when FindMetadataRepositories is called from outside the URLibService
	set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
	if ![info exists homePath] {
		regexp "(^.*)/col/" [pwd] m homePath
	}
	if ![info exists environmentArray] {
#		source $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray.tcl
		SourceWithBackup $homePath/col/$URLibServiceRepository/auxdoc/.environmentArray.tcl environmentArray	;# added by GJFB on 2010-08-05
	}
	if ![info exists loCoInRep] {
		Load $homePath/@loCoInRep loCoInRep
	}
	if ![info exists loBiMiRep] {
		Load $homePath/@loBiMiRep loBiMiRep
	}
	if ![string equal [info commands GetServerAddress] {GetServerAddress}] {
		source $homePath/col/$URLibServiceRepository/doc/utilitiesStart.tcl
	}
	if ![info exists serverAddress] {
		set serverAddress [GetServerAddress]
	}
	if ![info exists serverAddressWithIP] {
		set serverAddressWithIP [GetServerAddress 1]
	}
}

	if [string equal {} $siteList] {
		if [info exists env(LOBIMIREP)] {
			set currentRep $env(LOBIMIREP)	;# used in MultipleSubmit when siteList is empty
#			array set environment [array get env]	;# used in MultipleSubmit when siteList is empty
		} else {
			set currentRep $loBiMiRep
		}
	}

# MULTIPLE SUBMIT
	set scenario 0
	set query [list list GetMetadataRepositories {} $format $query $accent $case 0 {} repArray $codedPassword]
	set encodingName iso8859-1	;# used to send queries
if  0 {
	set level 1
	set pID {}
	set searchResultList {}
#	set siteList {}
# puts $query
# puts $siteList
	MultipleSubmit $pID $query searchResultList $scenario $siteList $level $encodingName $timeOut
} else {
# added by GJFB on 2012-12-16 to let FindMetadataRepositories to be used in the future with post (in post pid must not be empty)
	set level 2
#	set searchResultList [MultipleExecute $siteList $query $scenario $level $encodingName $timeOut]	;# level 2 is for MultipleSubmit be able to reach currentRep
	foreach {searchResultList numberOfSatisfiedQueries listOfActiveSites} [MultipleExecute2 $siteList $query $scenario $level $encodingName $timeOut] {break}	;# level 2 is for MultipleSubmit be able to reach currentRep
}
# puts <BR>
# puts --$searchResultList--
	if {$returnMessage && [string equal {} $searchResultList]} {
		puts {nothing found}
		return -code return
	}
	return $searchResultList
}

# FindMetadataRepositories - end
# ----------------------------------------------------------------------
# SetFieldValue
# used by CreateMirror, ReviewAssignment, Statistics and others
# async == 1 is used in oai
# returnEmptyFlag value is 0 or 1,
# 1 means to return empty when the communication with the server (site) doesn't start
# 0 means to produce an error
# site is the remote server address (should not be the http address of a virtual host)

proc SetFieldValue {site rep-i fieldNameList {async 0} {returnEmptyFlag 0}} {
	global serverAddress	;# local site

# Check conflicting server addresses
# added by GJFB on 2011-05-18
# accessing a local collection from both, the cable network and a wireless connection, may cause
# SetFieldValue not responding
# explanation:
# site value may be the result of a call to FindMetadataRepositories through the network cable
# but the returned value may correspond to a server address without domain name when the local
# collection were posted while the host computer was using a wireless connection and the network
# cable was unplugged
# example:
# SetFieldValue didn't return when run in mtc-m19, and URLibService hosted in
# banon-pc3 was posted using the wireless connection, and then the network cable plugged
# (in this case the site value has no domain name)
	foreach {localServerName urlibPort} [ReturnCommunicationAddress $serverAddress] {break}
# >>> here it is assumed that the complete host name without domain doesn't contain any periods (.)
	set domainNameFlag [regexp {\.} $localServerName]	;# 1 means that the local collection has a domain name
	foreach {serverName urlibPort} [ReturnCommunicationAddress $site] {break}
# >>> here it is assumed that the complete host name without domain doesn't contain any periods (.)
	if {$domainNameFlag && ![regexp {\.} $serverName]} {
# serverAddress has a domain name but site doesn't have
		foreach fieldName $fieldNameList {
			upvar $fieldName fieldValue
			set fieldValue {}
		}
		return
	}
# Check conflicting server addresses - end

if 0 {
# old code
# returning to the old code in 2013-07-20 by GJFB
# sometime fails because Submit gets a previous line instead of the current one leading to an error like: can't read "conversionTable(shown,%A)": no such element in array (using Set resume ID in the administrator page)
#	regexp {(.*):(.*)} $site m serverName serverPort
#	set localURLibClientSocketId [StartCommunication $serverName ${serverPort}0]
#	set localURLibClientSocketId [StartCommunication $serverName $urlibPort $async]	;# not async - needed with script.tcl (administrator page)
	set localURLibClientSocketId [StartCommunication $serverName $urlibPort $async utf-8]	;# not async - needed with script.tcl (administrator page) - solves the accent problem - communication from banon-pc3 to plutao - done by GJFB on 2010-07-09
#	set localURLibClientSocketId [StartCommunication $serverName $urlibPort $async utf-8 binary]	;# not async - needed with script.tcl (administrator page) - solves the accent problem - communication from banon-pc3 to plutao - done by GJFB on 2010-07-09
	foreach fieldName $fieldNameList {
		upvar $fieldName fieldValue
#		set fieldValue [Submit $localURLibClientSocketId [list GetFieldValue ${rep-i} $fieldName] 0]
		set fieldValue [Submit $localURLibClientSocketId [list GetFieldValue ${rep-i} $fieldName] $async]	;# done in 2008-10-15 to be in accordance with StartCommunication
	}
	close $localURLibClientSocketId
} else {
# new code by GJFB on 2012-07-14
# in 2013-07-19 this code results in the following error:
# CreateMirror: Execute (3): communication with server [192.168.1.100 800] doesn't start while trying to execute the command:
# GetFieldValue urlib.net/www/2010/11.25.00.45.29-0 editor
# errorInfo:
# --StartCommunication: communication doesn't start: couldn't open socket: address already in use
#    invoked from within
# "StartCommunication $serverName $urlibPort $async2 $encodingName"--
# this error occurs using: http://banon-pc3 > Sobre este Arquivo > Cadastramento de Usuario Avançado > banon > senha > Quero acessar meus trabalhos
# SUBMIT
# returning to the new code in 2013-07-21 by GJFB - URLib server failed in m19
# old code could be tested again in m19 because of use of SetFieldValue2 in GetURLPropertyList from 2013-08-16
	foreach fieldName $fieldNameList {
		upvar $fieldName fieldValue
		set fieldValue [Execute "$serverName $urlibPort" [list GetFieldValue ${rep-i} $fieldName] $async utf-8 $returnEmptyFlag]
	}
}
}

# SetFieldValue - end
# ----------------------------------------------------------------------
# FieldCompare
# used by CreateFullEntry (post) and CreateMirror (cgi script)

proc FieldCompare {a b} {
	global orderingTable	;# with cgi script, orderingTable is set by evaluating sourceDisplayControl (used for the review system only)
							;# with post, orderingTable is set by StartService (using ${referRepository}::orderingTable)
	upvar referenceType referenceType
	regsub {.*,} $a "$referenceType," aa	;# iconet.com.br/banon/2008/05.02.22.55,relevancia -> Misc,relevancia (with cgi script)
											;# dpi.inpe.br/banon/2001/02.23.19.30.12-0,shorttitle,author -> Thesis,author (with post)
	regsub {.*,} $b "$referenceType," bb
	if {[info exists orderingTable($aa)] && [info exists orderingTable($bb)]} {
		return [expr $orderingTable($aa) <= $orderingTable($bb)?-1:1]
	} elseif {[info exists orderingTable($aa)] && ![info exists orderingTable($bb)]} {
		return -1
	} elseif {![info exists orderingTable($aa)] && [info exists orderingTable($bb)]} {
		return 1
	} else {
		return [string compare $aa $bb]
	}
}

# FieldCompare - end
# ----------------------------------------------------------------------
# GetReferField
# referMetadata must contain a refer format string (e.g., content of @metadata.refer)
# fieldName is the field name without % (e.g. A, for author, but not %A)
# return a list of values in case of multiple line fields
# similar to the code in LoadMetadata
# examples:
# GetReferField $referMetadata 2
# GetReferField $referMetadata @group
# GetReferField {%D 2013} D
# => 2013

# WARNING: when editing a refer metadata (with EndNote for example)
# if the field value contains a % followed by no space or no
# punctuation mark (.;,), then this % must not appear at the
# beginning of a line (it may appear in the middle of a line).
# if no field is found, then return empty
# used by ProcessReview

# this procedure could be coded using ConvertReferFormatToListFormat

proc GetReferField {referMetadata fieldName} {
	global multipleLineReferFieldNamePattern
	
	set referMetadata2 \n[string trim $referMetadata \n]
	regsub -all {@} $referMetadata2 {#!#} referMetadata2	;# @ > #!#
	regsub -all "\n%(\[^ \\.;,\])" $referMetadata2 {@\1} referMetadata2
	regsub -all "\n+" $referMetadata2 { } referMetadata2
	set valueList {}
	set flag 0	;# 0 means field not found
	foreach field [lrange [split $referMetadata2 @] 1 end] {
		regsub -all {#!#} $field {@} field	;# #!# > @
		set field [string trimright $field]
		if [regexp "^$fieldName (.*)" $field m value] {
			lappend valueList $value
			set flag 1	;# field found
		} else {
			if $flag {break}
		}
	}
	if [regexp $multipleLineReferFieldNamePattern $fieldName] {
# multiple line field
		return $valueList
	} else {
		return [join $valueList]
	}
}

# not used any more after usergroup has been changed to a multiple line field
# return the first value encountered in case of multiple line fields
proc GetReferField2 {referMetadata fieldName} {
	set referMetadata2 \n[string trim $referMetadata \n]
	regsub -all {@} $referMetadata2 {#!#} referMetadata2	;# @ > #!#
	regsub -all "\n%(\[^ \\.;,\])" $referMetadata2 {@\1} referMetadata2
#	regsub -all "\n" $referMetadata2 { } referMetadata2
	regsub -all "\n+" $referMetadata2 { } referMetadata2
	set value {}
	foreach field [lrange [split $referMetadata2 @] 1 end] {
		regsub -all {#!#} $field {@} field	;# #!# > @
		set field [string trimright $field]
		if [regexp "^$fieldName (.*)" $field m value] {break}	;# return the first found
	}
	return $value
}

# GetReferField - end
# ----------------------------------------------------------------------
# PutReferField
# referMetadata must be in refer format (e.g., content of @metadata.refer)
# updates the referFieldName of a referMetadata with a fieldValue
# referMetadata must contain the %0 field, otherwise nothing is done

# referFieldName example: %@area
# fieldValue example: SO150000

# referFieldName example: %A
# fieldValue example: {{xx, yy,} {aa, bb,}} (multiple line fields)

# if the entry already exists, then it is updated, otherwise it is added
# if the field value is empty the field is deleted
# PutReferField returns the updated metadata in the refer format
# used by ProcessReview and others

proc PutReferField {referMetadata referFieldName fieldValue} {
#	global multipleLineReferFieldNamePattern	;# commented by GJFB on 2012-02-28 - now in ConvertReferFormatToListFormat and ConvertListFormatToReferFormat

#	if ![regexp "%0 (\[^%\]*)\n%" $referMetadata m referenceType] {return $referMetadata}
	if ![regexp "%0 \[^%\]*\n" $referMetadata\n] {return $referMetadata}
# puts $referMetadata
	set metadataEntryList3 [split [string trim $referMetadata \n] \n]	;# it is assumed that the field values don't contain \n - this is undertaken in Submit (cgi/submmit.tcl) - see DROP NEWLINES
# puts $metadataEntryList3
	ConvertReferFormatToListFormat metadataEntryList3 metadataEntryList2
# puts $metadataEntryList2	
	set i 0
	set addFlag 1
	foreach item $metadataEntryList2 {
		if [string equal $referFieldName [lindex $item 0]] {
			if [string equal {} $fieldValue] {
# delete
				set metadataEntryList2 [lreplace $metadataEntryList2 $i $i]
			} else {
# replace
				set item2 [lreplace $item end end $fieldValue]
				set metadataEntryList2 [lreplace $metadataEntryList2 $i $i $item2]
			}
			set addFlag 0
			break
		}
		incr i
	}
	if $addFlag {
# add
		set metadataEntryList2 [linsert $metadataEntryList2 1 [list $referFieldName $fieldValue]]
	}
# puts $metadataEntryList2
	ConvertListFormatToReferFormat metadataEntryList2 metadataEntryList3
# puts $metadataEntryList3
	return [join $metadataEntryList3 \n]
}

# PutReferField - end
# ----------------------------------------------------------------------
# ConvertListFormatToReferFormat
# used in Submit and PutReferField only

# List Format	(metadataEntryList2):	{%A {{Aa Bb} {Cc Dd}}} {%T {Tt tt}} {%@group {{} xx}}
# Refer Format	(metadataEntryList3):	{%A Aa Bb} {%A Cc Dd} {%T Tt tt} %@group {%@group xx}

proc ConvertListFormatToReferFormat {inputListName outputListName} {
	global multipleLineReferFieldNamePattern
	
	upvar $inputListName metadataEntryList2
	upvar $outputListName metadataEntryList3
# metadataEntryList2 -> metadataEntryList3

	set metadataEntryList3 {}
	foreach field $metadataEntryList2 {
		set fieldValueList [lindex $field 1]
		if [string equal {} $fieldValueList] {continue}
		set fieldName [lindex $field 0]	;# %A
		if [regexp $multipleLineReferFieldNamePattern $fieldName] {
# multiple line fields
			foreach fieldValue $fieldValueList {
				lappend metadataEntryList3 [string trim "$fieldName $fieldValue"]	;# trim is useful when fieldValue is empty
			}
		} else {
			lappend metadataEntryList3 [string trim [join $field]]	;# trim is useful when fieldValue is empty
		}
	}
}

if 0 {
set metadataEntryList2 {{%A {{Aa Bb} {Cc Dd}}} {%T {Tt \& tt}} {%@group {{} xx}} {%@nexthigherunit {xxx1 xxx2}}}
set multipleLineReferFieldNamePattern {A|E|Y|\?|O|@affiliation|@electronicmailaddress|@resumeid|@orcid|@group|@isbn|@issn}
ConvertListFormatToReferFormat metadataEntryList2 metadataEntryList3
set metadataEntryList3
# => {%A Aa Bb} {%A Cc Dd} {%T Tt \& tt} %@group {%@group xx} {%@nexthigherunit xxx1 xxx2}
ConvertListFormatToReferFormat metadataEntryList2 metadataEntryList3
set metadataEntryList3
set multipleLineReferFieldNamePattern {A|E|Y|\?|O|@affiliation|@electronicmailaddress|@resumeid|@orcid|@group|@isbn|@issn|@nexthigherunit}
# => {%A Aa Bb} {%A Cc Dd} {%T Tt \& tt} %@group {%@group xx} {%@nexthigherunit xxx1} {%@nexthigherunit xxx2}
}

# ConvertListFormatToReferFormat - end
# ----------------------------------------------------------------------
# ConvertReferFormatToListFormat
# used in PutReferField only

# Refer Format	(metadataEntryList3):	{%A Aa Bb} {%A Cc Dd} {%T Tt tt} %@group {%@group xx}
# List Format	(metadataEntryList2):	{%A {{Aa Bb} {Cc Dd}}} {%T {Tt tt}} {%@group {{} xx}}

proc ConvertReferFormatToListFormat {inputListName outputListName} {
	global multipleLineReferFieldNamePattern
	
	upvar $inputListName metadataEntryList3
	upvar $outputListName metadataEntryList2
# metadataEntryList3 -> metadataEntryList2

	set metadataEntryList2 {}
	set fieldNameList {}
	foreach field $metadataEntryList3 {
# lrange {%T Tt \& tt} 1 end => Tt & tt
# split {%T Tt \& tt} => %T Tt {\&} tt
# join [lrange [split {%T Tt \& tt}] 1 end] => Tt \& tt
#		set fieldValue [lrange $field 1 end]	;# doesn't preserve backslash
# puts $field
		set field [split $field]	;# preserve backslash
		set fieldValue [join [lrange $field 1 end]]	;# preserve backslash
#		if [string equal {} $fieldValue] {continue}	;# commented in 2010-06-29 otherwise %@group {%@group xx} -> {%@group xx} instead of {%@group {{} xx}}
		set fieldName [join [lindex $field 0]]	;# %A
		lappend array($fieldName) $fieldValue
# lsearch below must be with option -exact because of the field name %?
		if {[lsearch -exact $fieldNameList $fieldName] == -1} {
			lappend fieldNameList $fieldName
		}
	}
	foreach fieldName $fieldNameList {
		if [regexp $multipleLineReferFieldNamePattern $fieldName] {
# multiple line field
			lappend metadataEntryList2 [list $fieldName $array($fieldName)]
		} else {
			lappend metadataEntryList2 "$fieldName $array($fieldName)"
#			lappend metadataEntryList2 [join [list $fieldName $array($fieldName)]]
		}
	}
}

if 0 {
set multipleLineReferFieldNamePattern {A|E|Y|\?|O|@affiliation|@electronicmailaddress|@resumeid|@orcid|@group|@isbn|@issn}
set metadataEntryList3 {{%A Aa Bb} {%A Cc Dd} {%T Tt \& tt} %@group {%@group xx}}
ConvertReferFormatToListFormat metadataEntryList3 metadataEntryList2
set metadataEntryList2
# => {%A {{Aa Bb} {Cc Dd}}} {%T {Tt \& tt}} {%@group {{} xx}}
}

# ConvertReferFormatToListFormat - end
# ----------------------------------------------------------------------
# ReverseList

# not used
proc ReverseList2 {list} {
	set list2 {}
	foreach item $list {
		set list2 [concat [list $item] $list2]
	}
	return $list2
}

# ReverseList - end
# ----------------------------------------------------------------------
# CheckUsernamePasswordForm
# used by Submit, ProcessReview and Script (Administrator Page)
# it sets password1 (coded password)
# if password1 is empty CheckPassword checks the user name
# sessionTime value are milliseconds - added by GJFB on 2019-01-16

proc CheckUsernamePasswordForm {{sessionTime {}}} {
	global cgi
#	global env
	upvar serverAddressWithIP serverAddressWithIP
	upvar {unknown username} {unknown username}
	upvar {empty password} {empty password}
	upvar {wrong password} {wrong password}
	upvar password1 password1
	upvar homePath homePath
	upvar loCoInRep loCoInRep
	
	set password1 $cgi(codedpassword1)
# puts [list CheckPassword $cgi(username) --$password1--]
# puts --$serverAddressWithIP--
	set command [list list CheckPassword $cgi(username) $password1]	;# seeks in other sites
# puts $command
	set flag [MultipleExecute [list $serverAddressWithIP] $command]
	if [string equal 2 $flag] {
# unknown username
		return ${unknown username}
	}
	if [string equal {} $password1] {
# empty password
		return ${empty password}
	}
#	if [string equal {} $flag] {error "URLibService at $serverAddressWithIP is not responding: unpost and post it."}	;# commented by GJFB on 2021-01-02
	if [string equal {} $flag] {
		error "CheckUsernamePasswordForm: URLibService at $serverAddressWithIP is not responding: '$homePath/col/$loCoInRep/doc/@siteList.txt' might be out-of-date.\n[CallTrace]"
	}	;# added by GJFB on 2021-01-02 
	if $flag {
# wrong password
		return ${wrong password}
	}
	return {}
}

# CheckUsernamePasswordForm
# ----------------------------------------------------------------------
# CreateXMLNameValuePairs
# used by ConvertMetadata2XML and CreateXRefer
# outputMetadataFormat values are 0 or 1
# 1 means to return the metadata as a tcl list (one list element for one tag)
# 0 means to return the metadata as a simple string without the list struture
# dropTrailingComma values are 0 or 1
# 1 means to drop the trailing comma in multiple line fields (used to display only)
# 0 means to don't drop
# convertToUTF-8 values are 0 or 1
# 1 means to convert (used by CreateXRefer)
# 0 means to don't convert

proc CreateXMLNameValuePairs {fieldName fieldValue tagName {dropTrailingComma 0} {outputMetadataFormat 0} {convertToUTF-8 0}} {
	global multipleLineFieldNameList
#	if {[regexp {^affiliation|^author|^base|^cartographer|^committee|^editor|^electronicmailaddress} $fieldName] || \
#		[regexp {^firstaffiliation|^firstauthor|^firstbase|^firstcartographer|^firstcommittee|^firsteditor|^firstelectronicmailaddress} $fieldName] || \
#		[regexp {^firstgroup|^firstprogrammer|^firstreporter|^firstserieseditor|^firstsource|^firstsupervisor|^firsttranslator} $fieldName] || \
#		[regexp {^group|^programmer|^reporter|^serieseditor|^source|^supervisor|^translator} $fieldName]}
	if {[lsearch -exact $multipleLineFieldNameList $fieldName] != -1} {
# multiple line fields
		set metadata {}	;# added by GJFB on 2024-09-04 - some field values might be empty (example: value of citingitemlist)
		foreach value $fieldValue {
			if $dropTrailingComma {regsub {,*$} $value {} value} ;# drop trailing comma
			if ${convertToUTF-8} {set value [Convert $value]}	;# Convert is in cgi/oai.tcl
			if $outputMetadataFormat {
				lappend metadata \t\t<$tagName>$value</$tagName>
			} else {
				append metadata <$tagName>$value</$tagName>
			}
		}
	} else {
		regsub -all {/} $tagName {-} tagName	;# isbn/issn -> isbn-issn (/ is not a valid character within a tag)
#		regsub -all {&} $fieldValue {\&amp;} fieldValue	;# commented by GJFB on 2018-06-10 - this command ia already in Convert
#		regsub -all {<} $fieldValue {\&lt;} fieldValue	;# commented by GJFB on 2018-06-10 - this command ia already in Convert
#		regsub -all {>} $fieldValue {\&gt;} fieldValue	;# commented by GJFB on 2018-06-10 - this command ia already in Convert
		if ${convertToUTF-8} {set fieldValue [Convert $fieldValue]}	;# Convert is in cgi/oai.tcl
		if $outputMetadataFormat {
			lappend metadata \t\t<$tagName>$fieldValue</$tagName>
		} else {
			append metadata <$tagName>$fieldValue</$tagName>
		}
	}
	return $metadata
}

# CreateXMLNameValuePairs - end 
# ----------------------------------------------------------------------
# SetData
# example:
# SetData MTD2-BRRepository mtd2-brSigla.txt sigla
# used in dpi.inpe.br/banon-pc@1905/2005/02.19.00.40
# used in iconet.com.br/banon/2003/11.21.21.08

proc SetData {repName fileName varName} {
	global homePath
	upvar $varName var
	upvar #0 $repName rep
	if [file exists $homePath/col/$rep/auxdoc/$fileName] {
		Load $homePath/col/$rep/auxdoc/$fileName var
	} else {
# default (is in doc)
		file mkdir $homePath/col/$rep/auxdoc
		Load $homePath/col/$rep/doc/$fileName var
	}
}

# SetData - end
# ----------------------------------------------------------------------
# ConvertURLToHexadecimal
# url with @ results in "couldn't open socket: invalid argument" when using http::geturl
# binary scan @ H2 x; puts $x => 40
# encoding convertto utf-8 {a b ç d @} => a b ç d @
# binary scan ç H2H2 x y; puts $x => c3; ; puts $y => a7
# binary scan \{\} H2H2 x y; puts $x => 7b; ; puts $y => 7d
# see also ConvertStringToHexadecimal in
# col/iconet.com.br/banon/2005/12.29.23.16/doc/script.tcl
# convertToUTF8 value is 0 or 1
# 0 means to don't convert to UTF-8 (ex: ã -> %e3)
# 1 means to convert to UTF-8 (ex: ã -> %c3%a3) - used in get- and xxDocContent.html and col/iconet.com.br/banon/2005/12.29.23.16/doc/script.tcl (only)
## doesn't convert blank

proc ConvertURLToHexadecimal {url {convertToUTF8 0}} {

if 0 {
#	regsub -all {@} $url {%40} url	;# @ -> %40
	foreach character {@ ç { } ° #} {
		binary scan $character H2 hexadecimalCodification
		puts $hexadecimalCodification
#		regsub -all $character $url %$hexadecimalCodification url
	}
}
# puts {Content-Type: text/html}
# puts {}
# puts $url
if 1 {
# this line seems no more necessary to solve the accent problem mencioned below - GJFB 2015-01-09
	set url [encoding convertfrom utf-8 $url]	;# added by GJFB on 2012-05-21 - solves the accent problem when the url is utf-8 coded (e.g., when filling out the search field with the word "satélite" and clicking in OK in http://www.inpe.br)
}
	if [regexp {^([^?]*)\?(.*)$} $url m part1 part2] {
# solves the accent problem in a query string (preserves part2 from an utf-8 conversion), ex: http://plutao.sid.inpe.br/dpi.inpe.br/plutao@80/2008/08.19.15.01.21?query=satélite
# otherwise the search field is filled out with the string: satélite
		set part1 [ConvertURLToHexadecimal2 $part1 $convertToUTF8]
		set part2 [ConvertURLToHexadecimal2 $part2]
		set url $part1?$part2
	} else {
# solves the accent problem in the target file name of a document in an utf-8 OS, ex: http://banon-pc3/dpi.inpe.br/plutao@80/2009/07.13.14.44
# otherwise the httpd server may return a Not Found message
		set url [ConvertURLToHexadecimal2 $url $convertToUTF8]
	}
	return $url
}

if 0 {
	ConvertURLToHexadecimal http://hermes2.dpi.inpe.br:1905/col/dpi.inpe.br/banon-pc2@80/2007/06.12.21.20/doc/pdfInfo.cgi?fileurl=http://banon-pc2/col/iconet.com.br/banon/2007/04.29.22.55/doc/Ajustado+01.pdf&repname=iconet.com.br/banon/2007/04.29.22.55
# => http://hermes2.dpi.inpe.br:1905/col/dpi.inpe.br/banon-pc2%4080/2007/06.12.21.20/doc/pdfInfo.cgi?fileurl=http://banon-pc2/col/iconet.com.br/banon/2007/04.29.22.55/doc/Ajustado+01.pdf&repname=iconet.com.br/banon/2007/04.29.22.55
	ConvertURLToHexadecimal {http://mtc-m18.sid.inpe.br/col/sid.inpe.br/mtc-m18%4080/2009/09.18.02.15/doc/zaniboni dpi.txt}
	ConvertURLToHexadecimal {http://mtc-m18.sid.inpe.br/col/sid.inpe.br/mtc-m18@80/2009/09.18.02.15/doc/zaniboni dpi.txt}
	ConvertURLToHexadecimal {ç}
# => %e7
	ConvertURLToHexadecimal {ç} 1
# => %c3%a7
	ConvertURLToHexadecimal {{}}
# => %7b%7d	
	ConvertURLToHexadecimal {{}} 1
# => %7b%7d	
	ConvertURLToHexadecimal {/tmp/orçamento de janeiro/@siteList.txt}
# => /tmp/or%e7amento%20de%20janeiro/@siteList.txt
	ConvertURLToHexadecimal {/tmp/orçamento de janeiro/@siteList.txt} 1
# => /tmp/or%c3%a7amento%20de%20janeiro/@siteList.txt
	ConvertURLToHexadecimal {Brasil deve vender imagens de satélite a partir de 2005.pdf}
# => Brasil%20deve%20vender%20imagens%20de%20sat%e9lite%20a%20partir%20de%202005.pdf
	ConvertURLToHexadecimal {Brasil deve vender imagens de satélite a partir de 2005.pdf} 1
# => Brasil%20deve%20vender%20imagens%20de%20sat%c3%a9lite%20a%20partir%20de%202005.pdf
}

# ConvertURLToHexadecimal - end
# ----------------------------------------------------------------------
# ConvertURLToHexadecimal2

proc ConvertURLToHexadecimal2 {string {convertToUTF8 0}} {
	set splitedString [split $string {}]
	set splitedString2 {}
	foreach character $splitedString {
#		if {[regexp {[[:alpha:]]|@|<|>|¦| |\[|\]|\{|\}} $character] && ![regexp {[a-zA-Z]} $character]} # commented by GJFB on 2015-01-09 to conform with the norm - @ need not to be converted into hexadecimal
#		if {[regexp {[[:alpha:]]|<|>|¦| |\[|\]|\{|\}} $character] && ![regexp {[a-zA-Z]} $character]} # commented by GJFB on 2016-06-07
#		if {[regexp {[[:alpha:]]|<|>|¦| |°|\[|\]|\{|\}} $character] && ![regexp {[a-zA-Z]} $character]} #	;# added by GJFB on 2016-06-07 - needed when sending a permission transfer warning e-mail and the title contains the character ° (see SendPermissionTransferWarningEMail)
#		if {[regexp {[[:alpha:]]|<|>|¦| |°|\[|\]|\{|\}|"} $character] && ![regexp {[a-zA-Z]} $character]} #	;# added by GJFB on 2017-04-02 - needed in Get when the title field contains " as in id J8LNKB5R7W/3N6MLES
#		if {[regexp {[[:alpha:]]|<|>|¦| |°|\[|\]|\{|\}|"|\|} $character] && ![regexp {[a-zA-Z]} $character]} #	;# added by GJFB on 2017-07-18 - needed in Get- when the url contains a query with | as in y 1983|*
		if {[regexp {[[:alpha:]]|[<>¦ °\[\]{}"|$]} $character] && ![regexp {[a-zA-Z]} $character]} {	;# added by GJFB on 2019-10-10 - needed in Get when the url contains a query with $ as in title R$ 2,7 (in pairList)
# the character is an accented character or < or > or ¦ or a blank or { or } or " or | or $
			if $convertToUTF8 {
				set convertedCharacter [split [encoding convertto utf-8 $character] {}]
			} else {
#				set convertedCharacter $character
				set convertedCharacter [list $character]	;# list is needed because of the foreach below when the character is a blank
			}
			foreach character2 $convertedCharacter {
				binary scan $character2 H2 hexadecimalCodification
				lappend splitedString2 %$hexadecimalCodification
			}
		} else {
# the character is neither an accented character nor < nor > nor ¦ nor a blank nor { nor } nor " nor | nor $
			lappend splitedString2 $character
		}
	}
	return [join $splitedString2 {}]
	
}

# ConvertURLToHexadecimal2 - end
# ----------------------------------------------------------------------	
# KeepInitials
# comma values are {,} or {}
# {} is used in the BibINPE format
# example:
# with comma == {,}
# KeepInitials returns: Banon, G. J. F.,
# with comma == {}
# KeepInitials returns: Banon, G. J. F.
# firstNameAbbreviation value is 0 or 1; 1 means to abbreviate

proc KeepInitials {authorList {comma {}} {firstNameAbbreviation 1}} {
	set authorList2 {}
	foreach author $authorList {
		regsub {,$} $author {} author
		if $firstNameAbbreviation {
# abbreviate
			if [regexp {(.*),(.*)} $author m lastName otherNames] {
				lappend authorList2 "$lastName, [ExtractInitials $otherNames]$comma"
			} else {
				lappend authorList2 "$author$comma"
			}
		} else {
			if [regexp {(.*), +([^ ]+) +(.*)} $author m lastName firstName otherNames] {
				lappend authorList2 "$lastName, [string trim "$firstName [ExtractInitials $otherNames 1]"]$comma"
			} else {
				lappend authorList2 "$author$comma"
			}
		}
	}
	return $authorList2
}

# KeepInitials - end
# ----------------------------------------------------------------------
# ExtractInitials
# preserve value is 0 or 1; 1 means to preserve the von token
# example: ExtractInitials {Jean Francis}
# => J. F.
# example: ExtractInitials {Michael ten}
# => M.
# example: ExtractInitials {Michael ten} 1
# => M. ten
# example: Abraham Chian-Long
# => A. C.-L.

proc ExtractInitials {wordList {preserve 0}} {
	set initials ""
	foreach name $wordList {
		set firstLetter [string index $name 0]
		if [regexp {[A-ZÁÀÃÂÄÇÉÈÊËÍÌÎÏÓÒÕÔÖÚÙÛÜÝŸ]} $firstLetter] {
			set initials [concat $initials $firstLetter.] 
		} else {
			if $preserve {
				set initials [concat $initials $name]	;# useful for names like Michael ten Caat
			}
		}
		set subNameList [split $name -]	;# useful for names like Abraham Chian-Long Chian
		if {[llength $subNameList] > 1} {
			foreach subName [lrange $subNameList 1 end] {
				set firstLetter [string index $subName 0]
				set initials "$initials-$firstLetter." 
			}
		}
	}
	return $initials
}

# ExtractInitials - end
# ----------------------------------------------------------------------
# Include

proc Include {path} {
	Load $path fileContent
	return $fileContent
}

# new version - still testing - used in CreateMirror
proc Include2 {repName path} {
	SynchronizeRepository $repName
	Load $path fileContent
	return $fileContent
}

# Include - end
# ----------------------------------------------------------------------
# CheckCommunication
# returns 1 if the communication fails and 0 otherwise

proc CheckCommunication {} {
	global env
	global localSite
	global homePath

	set mtime [file mtime $homePath/index.html]
	if {[string compare $mtime [expr [clock seconds] - 10]] == 1} {return 0}	;# test again urlib server only 10s after the last test

# serverAddress
	set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]

	if [ReturnServerTest $serverAddress urlib] {
		StoreIndex
		return 0	;# communication works
	} else {
		StoreIndex 0
		puts "Location: http://$localSite"
		puts ""
		return 1	;# communication fails
	}
}

# CheckCommunication - end
# ----------------------------------------------------------------------
# StoreIndex
# flag value is 0 or 1
# 1 is for posting (default)
# 0 is for unposting
# called in post, CheckCommunication, Run-exit and SPOK

proc StoreIndex {{flag 1}} {
# runs with post and cgi script (see CheckCommunication called in Get-)
	global homePath
	global loBiMiRep
	global englishMirrorRepository
	global env
	global localSite
	
	if {[info exists env(DOCUMENT_ROOT)] && \
		[info exists env(LOBIMIREP)] && \
		[info exists env(ENGLISH_MIRROR_REP)]} {
# a cgi script
		set homePath $env(DOCUMENT_ROOT)
		set loBiMiRep $env(LOBIMIREP)
		set englishMirrorRepository $env(ENGLISH_MIRROR_REP)
	}

	if $flag {
# for posting
		regsub -all { } $localSite {+} localSite2	;# localSite2 is not used anymore from 2021-12-27 - when opening the home page, localSite2 is depending on $env(SERVER_PORT) and might lead to a corrupt value for localSite2 because of some old cache value of env(SERVER_PORT) (it happened to be 80 instead of 1905 after installing ibi.nic.br with an unkown Apache version)
		set archive [ReturnHTTPHost]	;# archive is depending on $env(URLIB_PORT) whose value doesn't depend on Apache
		set fileContent "
			<HTML>
				<HEAD>
					<TITLE>Redirection to the Bibliographic Mirror</TITLE>
					<!-- <META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=http://$archive/rep-/$loBiMiRep?ibiurl.requiredsite=$localSite2\"> -->
					<!-- <META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=http://$archive/ibi/$loBiMiRep?ibiurl.requiredsite=$archive\"> -->
					<META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=http://$archive/ibi/$loBiMiRep?ibiurl.requiredsite=$archive&forcehistorybackflag=0\">
				</HEAD>
				<BODY>
					<!-- [CallTrace] -->
				</BODY>
			</HTML>
		"
		file mkdir $homePath/mirror
		Store fileContent $homePath/mirror/index.html
		set fileContent "
			<HTML>
				<HEAD>
					<TITLE>Redirection to the Bibliographic Mirror</TITLE>
					<META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=http://[ReturnHTTPHost]/mirror/\">
				</HEAD>
				<BODY>
				</BODY>
			</HTML>
		"
	} else {
# for unposting
		set fileContent "
			<HTML>
				<HEAD>
					<TITLE>Unposted Collection Warning</TITLE>
					<link rel=\"stylesheet\" type=\"text/css\" href=\"col/$englishMirrorRepository/doc/mirrorStandard.css\">
				</HEAD>
				<BODY class=\"aboutBody\">
					<TABLE HEIGHT=\"100%\" ALIGN=\"CENTER\"><TR><TD>Collection at <FONT FACE=\"Courier New\">&lt;[ReturnHTTPHost]&gt;</FONT> is unposted.</TD><TR></TABLE>
				</BODY>
			</HTML>
		"
	}
	Store fileContent $homePath/index.html
}

# StoreIndex - end
# ----------------------------------------------------------------------
# AllowedRemoteAddress
# returns 1 if the remote address belongs to the permissionList
# permissionList is usually defined in displayControl.tcl
# otherwise returns 0
# may be used in CreatePermissionList when sourcing displayControl.tcl (in this case env(REMOTE_ADDR) doesn't exist)

proc AllowedRemoteAddress {permissionList} {
	global env

	set found 0
	if [info exists env(REMOTE_ADDR)] {
		foreach permission $permissionList {
			if [regexp ^$permission $env(REMOTE_ADDR)] {set found 1; break}	;# the pattern ^^x is equivalent to ^x
		}
	}
	return $found
}

# AllowedRemoteAddress
# ----------------------------------------------------------------------
# ReturnUserData
# returns data in userArray for the user userName of type userType
# userType is read or write

proc ReturnUserData {userName userType} {
	upvar userArray userArray
	if [info exists userArray($userName,e-mailaddress)] {
		set eMailAddress $userArray($userName,e-mailaddress)
	} else {
		set eMailAddress {}
	}
	if {[string compare {write} $userType] == 0} {
# write
		if [info exists userArray($userName,fullname)] {
			set fullName $userArray($userName,fullname)
		} else {
			set fullName {}
		}
		if [info exists userArray($userName,resumeid)] {
			set resumeID $userArray($userName,resumeid)
		} else {
			set resumeID {}
		}
		if [info exists userArray($userName,orcid)] {
			set orcid $userArray($userName,orcid)
		} else {
			set orcid {}
		}
		if [info exists userArray($userName,cpf)] {
			set CPF $userArray($userName,cpf)
		} else {
			set CPF {}
		}
#		if [info exists userArray($userName,theme)] #
		if [info exists userArray($userName,subject)] {
#			set theme $userArray($userName,theme)
			set theme $userArray($userName,subject)
		} else {
			set theme {}
		}
		regsub -all { } $fullName {+} fullName2
		regsub -all { } $theme {+} theme2
		return [list $eMailAddress $fullName2 $theme2 $resumeID $orcid $CPF]
	} else {
# read
		return [list $eMailAddress]
	}
}

# ReturnUserData - end
# ----------------------------------------------------------------------
# FindCurrentHTMLFileName
# used by CreateMirror and ForcePassword
# rootName is for example About

proc FindCurrentHTMLFileName {rootName} {
	global homePath
	global language languageRep1 languageRep2
	global submissionFormLanguage submissionFormLanguageRep

	if [file exists $homePath/col/$submissionFormLanguageRep/doc/$submissionFormLanguage$rootName.html] {
		set currentFileName $homePath/col/$submissionFormLanguageRep/doc/$submissionFormLanguage$rootName.html
	} else {
		if [file exists $homePath/col/$languageRep1/doc/$language$rootName.html] {
			set currentFileName $homePath/col/$languageRep1/doc/$language$rootName.html
		} else {
			set currentFileName $homePath/col/$languageRep2/doc/$language$rootName.html
		}
	}
	return $currentFileName
}

# FindCurrentHTMLFileName - end
# ----------------------------------------------------------------------
# sourceDisplayControl
# 1. col/$mirrorHomePageRepository/doc/displayControl.tcl
# 2. col/$submissionFormRep/doc/controlArray.tcl
# 3. col/$submissionFormRep/doc/displayControl.tcl
# 4. col/$submissionFormRep/auxdoc/@writePermission.tcl (for old installation)
# 5. col/$mirrorHomePageRepository/auxdoc/displayControl.tcl (useful to avoid creating a new repository with a copy of the default mirror home page when some mirror customization is required like setting a new value for mirrorPageOpeningOption)
# 6. col/$submissionFormRep/auxdoc/displayControl.tcl (option 3 should be used instead)

set sourceDisplayControl {
if 0 {
if $enableOutput {
	puts {Content-Type: text/html}
	puts {}
}
puts $mirrorHomePageRepository	;# is set to dpi.inpe.br/banon/2000/01.23.20.24 in CreateMirror, MirrorSearch and Submit - this repository contains the default mirror home page
puts $submissionFormRep
# exit
}
# 1. col/$mirrorHomePageRepository/doc/displayControl.tcl
	set controlFileName2 col/$mirrorHomePageRepository/doc/displayControl.tcl
	if [file exists $homePath/$controlFileName2] {
		source $homePath/$controlFileName2
		set controlFileName $controlFileName2	;# for reverse engineering
		set sourcedFileArray(1) $controlFileName2	;# for tracing sourced file name
	}
# puts --[lindex $displayTable(Report,filename) 3]--
# => ----	
# puts --[lindex ${displayTable(Audiovisual Material,%O)} 0]--
# => --1.2--
# puts --$displayTable(Report,%@contenttype)--
	
# 3. -> 2. col/$submissionFormRep/doc/controlArray.tcl
# by GJFB on 2015-02-07 - now controlArray.tcl contains the publishingYear that may be useful when sourcing displayControl.tcl at the next stage
	set controlFileName2 col/$submissionFormRep/doc/controlArray.tcl
	if [file exists $homePath/$controlFileName2] {
# Process controlArray
		source $homePath/$controlFileName2
		set controlFileName $controlFileName2	;# for reverse engineering
		set sourcedFileArray(2) $controlFileName2	;# for tracing sourced file name
		foreach index [array names controlArray] {
			set $index $controlArray($index)
		}
# Process controlArray - end
	}
# puts --[lindex $displayTable(Report,filename) 3]--
# => ----	
# puts --[lindex ${displayTable(Audiovisual Material,%O)} 0]--
# => --0--	

# puts ${searchOptionTable(Conference Proceedings)}

# 2. -> 3. col/$submissionFormRep/doc/displayControl.tcl
	if ![string equal $mirrorHomePageRepository $submissionFormRep] {

		if ![file exists $homePath/col/$submissionFormRep/doc/@disableSyncronization.txt] {
# The content of the file @disableSyncronization.txt may be anything.
# Just its name is meaningful.
# If not using this file in a site containing a copy of displayControl.tcl
# any local changes of the displayControl.tcl copy may be lost if the
# local and remote metadata last update of $submissionFormRep doesn't match
# when opening a form
# the file @disableSyncronization.txt is created manually only.
# puts "SynchronizeRepository $submissionFormRep"
			SynchronizeRepository $submissionFormRep
		}
		
# puts --$publishingYear--
		
		set controlFileName2 col/$submissionFormRep/doc/displayControl.tcl
# puts [file exists $homePath/$controlFileName2]		
		if [file exists $homePath/$controlFileName2] {
			if [catch {source $homePath/$controlFileName2} error] {
				if $enableOutput {
					puts {Content-Type: text/html}
					puts {}
				}
				puts "sourceDisplayControl: error in sourcing file <TT>&lt\;$env(DOCUMENT_ROOT)/col/$submissionFormRep/doc/displayControl.tcl&gt\;</TT>:"
				puts <BR>
#				puts $error
				global errorInfo
				puts $errorInfo
# puts --$update--
# global errorInfo; puts $errorInfo
			}
			set controlFileName $controlFileName2	;# for reverse engineering
			set sourcedFileArray(3) $controlFileName2	;# for tracing sourced file name
		}
# puts [info exists attributeTableFileList]
	}
# puts $controlFileName2
# => col/iconet.com.br/banon/2003/05.31.10.26/doc/displayControl.tcl
# puts --[lindex $displayTable(Report,filename) 3]--
# => --File Name<BR>(attach here your file)--
# puts --$displayTable(Report,%@contenttype)--

# 4. col/$submissionFormRep/auxdoc/@writePermission.tcl (for old installation)
	set controlFileName2 col/$submissionFormRep/auxdoc/@writePermission.tcl
	if [file exists $homePath/$controlFileName2] {
		source $homePath/$controlFileName2
		set controlFileName $controlFileName2	;# for reverse engineering
		set sourcedFileArray(4) $controlFileName2	;# for tracing sourced file name
	}

# 5. col/$mirrorHomePageRepository/auxdoc/displayControl.tcl
	set controlFileName2 col/$mirrorHomePageRepository/auxdoc/displayControl.tcl
	if [file exists $homePath/$controlFileName2] {
		source $homePath/$controlFileName2
		set controlFileName $controlFileName2	;# for reverse engineering
		set sourcedFileArray(5) $controlFileName2	;# for tracing sourced file name
	}
# puts --$displayTable(Report,%@contenttype)--

# 6. col/$submissionFormRep/auxdoc/displayControl.tcl
	set controlFileName2 col/$submissionFormRep/auxdoc/displayControl.tcl
	if [file exists $homePath/$controlFileName2] {
		source $homePath/$controlFileName2
		set controlFileName $controlFileName2	;# for reverse engineering
		set sourcedFileArray(6) $controlFileName2	;# for tracing sourced file name
	}
# puts --$displayTable(Report,%@contenttype)--
# => --3 {} {} {}--
	
if 1 {
# display for tracing sourced file name
	set sourcedFiles {<!--}
	lappend sourcedFiles {    sourced files used for customizing this form are (see sourceDisplayControl):}
	foreach name [lsort [array names sourcedFileArray]] {
		lappend sourcedFiles "    $name $sourcedFileArray($name)"
	}
	lappend sourcedFiles {-->}
	set sourcedFiles [join $sourcedFiles \n]
}
	
# puts $sourcedFiles
# exit

# puts [info exists publishingYear]
	if {[info exists publishingYear] && [info exists attributeTableFileList]} {
		foreach attributeTableFile $attributeTableFileList {
			Source $attributeTableFile attributeTable	;# set attributeTable
		}
	}
# puts $automaticFilling
# puts [info exists attributeTable]
# puts [array get updateOptionTable]
# puts [array get displayTable]
# puts [lindex $displayTable(Report,filename) 3]	
}

# sourceDisplayControl - end
# ----------------------------------------------------------------------
# CreateReviewButton
# used in CreateBriefEntry and in CreateMirror
# rep is the work repository
# childRepositories are its children

proc CreateReviewButton {rep-i rep mirrorRepository childRepositories {window {}}} {
	global serverAddressWithIP
	global localSite
	
	upvar translationTable translationTable

	SetFieldValue $serverAddressWithIP ${rep-i} {readergroup}
	if [string equal {} $readergroup] {return {}}

	set showReview 0
	foreach childRepository $childRepositories {
		set childMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $childRepository]]
		SetFieldValue $serverAddressWithIP $childMetadataRep-0 {documentstage}
		if [string equal {Closed Review} $documentstage] {set showReview 1; break}
	}
	if {$showReview && ![string equal {} $mirrorRepository]} {
# $mirrorRepository is used by the review cgi
		if [string equal {} $window] {
# metadataRep and i
			regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i
			regsub -all {/} ${mirrorRepository}___$metadataRep {__} window
			regsub -all {\.|@|-} $window {_} window
			set window ${window}___$i
		}
		return "<A HREF=http://$localSite/review/$rep?languagebutton=\$language&mirror=$mirrorRepository ONCLICK=\"window.open('', 'review___$window', 'width=760,height=450,scrollbars=yes,menubar=yes,resizable=yes,toolbar=yes')\" TARGET=review___$window>$translationTable(review)</A>"
	} else {
		return {}
	}
}

# CreateReviewButton - end
# ----------------------------------------------------------------------
# CreateVersionStamp
# used in Dialog, LoadMetadata, UpdateSiteList and script (adm. page)
# works with gmt
# userName is the name of the advanced user who is creating the version stamp
# is optional
# referMetadata must contain a refer format string (e.g., content of @metadata.refer)

proc CreateVersionStamp {seconds {userName {}} {referMetadata {}}} {
# runs with start and post
	global loCoInRep
# puts --$referMetadata--
# puts [CallTrace]
	if ![info exists loCoInRep] {
		global env
		set loCoInRep $env(LOCOINREP)
	}
	set newTime [clock format $seconds -format %Y:%m.%d.%H.%M.%S -gmt 1]
# puts >>>>$newTime
	if [string equal {} $referMetadata] {
		return [concat $newTime $loCoInRep $userName]
	} else {
		set year [GetReferField $referMetadata D]
		return [concat $newTime $loCoInRep $userName [list [list D $year]]]
	}
}

# CreateVersionStamp - end
# ----------------------------------------------------------------------
# ChangeFieldValue
# changes the respective oldFieldValue to the respective newFieldValue for the respective fieldName
# in metadataList, metadata2List and @metadata.refer
# used just in Script (dpi.inpe.br/banon-pc@1905/2005/02.19.00.40), MountHTMLPage (displaydoccontent.tcl)
# and in Script (iconet.com.br/banon/2007/01.01.16.00)

# the respective range permits to preserve the part of the respective oldFieldValue which doesn't belongs to the respective range (see example below)
# let new = newFieldValue
# let old = oldFieldValue
# new belongs to range
# if range != {} do:
# newFieldValue = new + (old - range) = PRE PN IPV
# if range == {} do:
# newFieldValue = new
# 
# example:
# old = PRE PI IPV
# new = PRE PN
# range = PRE PN PI
# old - range = IPV
# fieldValue = new + (old - range) = PRE PN IPV

# proc ChangeFieldValue {serverAddress metadatarepository metadatalastupdate fieldNameList oldFieldValueList newFieldValueList userName codedPassword} #
proc ChangeFieldValue {serverAddress metadatarepository metadatalastupdate fieldNameList oldFieldValueList newFieldValueList rangeList userName codedPassword} {
	global homePath
	
	upvar metadataList metadataList
	upvar metadata2List metadata2List

# Update @metadata.refer
	foreach fieldName $fieldNameList oldFieldValue $oldFieldValueList newFieldValue $newFieldValueList range $rangeList {
		if ![string equal {} $range] {
#			set newFieldValue [concat $newFieldValue [ListNegatedImplication oldFieldValueList range]]	;# commented by GJFB on 2015-01-17 - wrong ListNegatedImplication first argument - e.g., secondarytype becomes: PRE PN {WEBSCI; PORTALCAPES; SCIELO; MGA; COMPENDEX.} 0104-7760 {PRE PI}
			set newFieldValue [concat $newFieldValue [ListNegatedImplication oldFieldValue range]]	;# added by GJFB on 2015-01-17
		}
		Execute $serverAddress [list UpdateReferMetadata $metadatarepository [list [list $fieldName $newFieldValue]] $userName $codedPassword]
	}
# Update @metadata.refer - end
																
# Update history
# CREATE A NEW VERSION STAMP (for the metadata repository (metadatarepository))
	set seconds [clock seconds]
	Load $homePath/col/$metadatarepository/doc/@metadata.refer referMetadata
	set metadataVersionStamp [CreateVersionStamp $seconds administrator $referMetadata]
	Execute $serverAddress [list UpdateHistory $metadatarepository $metadataVersionStamp]
# Update history - end

# remove
	set metadata2List [concat $metadata2List [list $metadatarepository-0,metadatalastupdate $metadatalastupdate]]
# add
	set metadataList [concat $metadataList [list $metadatarepository-0,metadatalastupdate $metadataVersionStamp]]
	
	foreach fieldName $fieldNameList oldFieldValue $oldFieldValueList newFieldValue $newFieldValueList range $rangeList {
		if ![string equal {} $range] {
			set newFieldValue [concat $newFieldValue [ListNegatedImplication oldFieldValue range]]
		}
# remove
		set metadata2List [concat $metadata2List [list $metadatarepository-0,$fieldName $oldFieldValue]]
# add
		if ![string equal {} $newFieldValue] {
			set metadataList [concat $metadataList [list $metadatarepository-0,$fieldName $newFieldValue]]
		}
	}
}

# ChangeFieldValue - end
# ----------------------------------------------------------------------
# ComputeMark
# used in Submit when processing review and in ProcessReview
# updates markList 
## repName is the name of the current review repository
## workRepository is its parent repository
# Example: ComputeMark $parentRepository $subject

proc ComputeMark {workRepository subject} {
	upvar markList markList
	upvar serverAddressWithIP serverAddressWithIP
	upvar homePath homePath
	upvar orderingTable orderingTable
	upvar optionTable2 optionTable2

# mark == {workRepository childrepositories title subject session theme tertiarytype averageMark overallRating recommendation formatRecommendation confidence comments accepted}

	set workMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $workRepository]]
	SetFieldValue $serverAddressWithIP $workMetadataRep-0 {childrepositories title session type tertiarytype mark}

	set numberOfReviews 0

	set averageMark 0
	set overallRating {}
	set recommendation {}
	set formatRecommendation {}
	set confidence {}
	set comments {}

	set markIndex [lsearch -regexp $markList "^$workRepository "]

	set reviewRepList {}
	foreach childRep $childrepositories {
		set childMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $childRep]]
		SetFieldValue $serverAddressWithIP $childMetadataRep-0 {documentstage}
		if ![regexp {Closed} $documentstage] {continue}
# closed review
		lappend reviewRepList $childRep
		if [info exists reviewArray] {unset reviewArray}
# puts source
# puts [list --$repName-- $childRep]
# SOURCE review
		source $homePath/col/$childRep/doc/.reviewArray.tcl
# numberOfReviews
		incr numberOfReviews
# averageMark
		foreach index [array names reviewArray] {
			if [regexp {,significance$|,originality$|,technicalsoundness$|,presentation$} $index] {
				incr averageMark $reviewArray($index)
			}
		}
# overallRating
		lappend overallRating $reviewArray($childRep,overallrating)
# recommendation
		lappend recommendation $reviewArray($childRep,recommendation)
# formatRecommendation
		lappend formatRecommendation $reviewArray($childRep,presentationformatrecommendation)
# confidence
		lappend confidence $reviewArray($childRep,confidenceintheevaluation)
# numberOfComments
		lappend comments [expr [string compare {} $reviewArray($childRep,commentsfortheprogramcommitteeonly)] != 0]
	}
# puts OK
	if $numberOfReviews {
		set averageMark [expr ($averageMark * 10) / $numberOfReviews]
	} else {
# no closed review
# compute the greatest average mark
		foreach index [array names orderingTable Misc,*] {
			if [regexp {,significance$|,originality$|,technicalsoundness$|,presentation$} $index] {
				set markValue [lindex [lindex $optionTable2($index) 0] end]
				if {[string compare {} $markValue] != 0} {
					incr averageMark $markValue
				}
			}
		}
		set averageMark [expr $averageMark * 10]
# compute the greatest average mark - end
	}

	set accepted $mark

	set markList [lreplace $markList $markIndex $markIndex \
	[list $workRepository $reviewRepList $title $subject $session $type $tertiarytype $averageMark $overallRating $recommendation $formatRecommendation $confidence $comments $accepted]]
}

# ComputeMark - end
# ----------------------------------------------------------------------
# UpdateRobotstxtFile
# disallows hidden repository or repository with restrition access
# visibility value is 0 or 1; 0 means shown, 1 means hidden repository at search
# docPermission value is 0 or 1; 0 means allowed, 1 means denied
# if lineListName is not empty then lineList must exist and begin like:
# {{User-agent: *} {Disallow:} ...}
# the new lines (if any) are lappended to lineList and the files
# robots.txt and robots2.txt are ignored

proc UpdateRobotstxtFile {rep visibility docPermission {lineListName {}}} {
# runs with start and post
	global homePath
	
	set flag [string equal {} $lineListName]
	
	if $flag {
		Load $homePath/robots.txt fileContent
		set lineList [split [string trim $fileContent] \n]
	} else {
		upvar $lineListName lineList
	}
	
	set lineList [lrange $lineList 1 end]	;# drop User-agent: *
	if {[lsearch -exact $lineList {Disallow: /}] != -1} {
		set disallowFlag 1	;# disallow
		if $flag {
# added by GJFB on 2014-06-22
			Load $homePath/robots2.txt fileContent
			set lineList [lrange [split [string trim $fileContent] \n] 1 end]	;# drop User-agent: *
		}
	} else {
		set disallowFlag 0	;# allow
	}
	
# process the default robots.txt file
	if {[set i [lsearch -exact $lineList {Disallow:}]] != -1} {
		set lineList [lreplace $lineList $i $i]	;# drop Disallow:
	}
	if {[set i [lsearch -exact $lineList {Disallow: /}]] != -1} {
		set lineList [lreplace $lineList $i $i]	;# drop Disallow: /
	}
# process the default robots.txt file - end

	set metadataRep [Eval FindMetadataRep $rep]
	set metadataRepList [Eval FindAllLanguageVersions $metadataRep]
	
	foreach item [concat $rep $metadataRepList] {
		if {[set i [lsearch -exact $lineList "Disallow: /col/$item"]] != -1} {
			set lineList [lreplace $lineList $i $i]	;# drop old line
		}
	}
	
#	if {$visibility || $docPermission} #
	if {[string equal {} $visibility] || $visibility || $docPermission} {	;# added by GJFB on2015-05-08 - the visibility attribute might have been lost in the service directory
# disallow
		foreach item [concat $rep $metadataRepList] {
			lappend lineList "Disallow: /col/$item"	;# add new line
		}
	}

# Migration 2011-06-15
# for Google to remove the files agreement/autorizacao.pdf
	if [file exists $homePath/col/$rep/agreement/autorizacao.pdf] {
		lappend lineList "Disallow: /col/$rep/agreement/autorizacao.pdf"
	}
# Migration 2011-06-15	
	
	set lineList [concat {{User-agent: *}} $lineList]	;# add User-agent: *
	if {[llength $lineList] == 1} {
		set lineList [concat $lineList {{Disallow:}}]	;# add Disallow:
	}
	if $flag {
		set fileContent [join $lineList \n]
		if !$disallowFlag {Store fileContent $homePath/robots.txt}	;# not disallow the whole site - update robots.txt as well
		Store fileContent $homePath/robots2.txt	;# useful when it is necessary to withdraw Disallow: / in robots.txt; in this case it is sufficient to a copy the content of robots2.txt into robots.txt
	}
}

# UpdateRobotstxtFile - end
# ----------------------------------------------------------------------
# SetWidgetValue
# word value is SELECTED for menu or CHECKED for check box and radio
# used in Script (administrator pages) within:
# iconet.com.br/banon/2006/07.02.02.18
# iconet.com.br/banon/2007/01.01.16.00

proc SetWidgetValue {name indexList word} {
	upvar cgi cgi

	if ![info exists cgi($name)] {set cgi($name) {}}
	if [string equal {SELECTED} $word] {
# menu
# example: $cgi($name) == Journal Article
		set list [list $cgi($name)]
# example: $list == {Journal Article}
	} else {
# check box and radio
		set list $cgi($name)
	}
	foreach index $indexList {
		upvar ${name}_$index ${name}_$index
		if {[lsearch $list $index] != -1} {
			set ${name}_$index $word
		} else {
			set ${name}_$index {}
		}
	}
}

# SetWidgetValue - end
# ----------------------------------------------------------------------
# SetFieldProperties
# fielName is for example: Affiliation (or Significance with review form)
# referFieldName is for example: %@affiliation (or significance with review form)
# used in Script within col/iconet.com.br/banon/2006/07.02.02.18/doc/cgi/script.tcl
# (Administrator page for customizing the conference submission forms)

proc SetFieldProperties {fieldName referFieldName referenceType fieldType {requirementType {<FONT COLOR=BROWN>(*)</FONT>}}} {

	set fieldNameToLower [string tolower $fieldName]
	set firstLetter [string index $fieldNameToLower 0]
	set fieldName2 [string replace $fieldName 0 0 $firstLetter]

	upvar 1 "controlArray(display${fieldName}FieldTable($referenceType))" display
	upvar 1 "controlArray(${fieldName2}FieldRequiredTable($referenceType))" required
	upvar 1 "controlArray(${fieldName2}FieldHelpTable($referenceType))" help
	upvar 1 "controlArray(${fieldName2}FieldNameTable($referenceType))" name
	upvar 1 controlArray controlArray

		if [info exists display] {
			if [info exists required] {
				set fieldRequired $requirementType
			} else {
				set fieldRequired {}
			}
			if [info exists help] {
				set fieldHelp "\[Help $fieldName\]"
			} else {
				set fieldHelp {}
			}
			if {[string equal {} $name] && ![info exists field::conversionTable($fieldNameToLower)]} {
# name2 must not be empty when fieldName is for example Significance because such field is not defined in field::conversionTable)
				set name2 $fieldName
			} else {
				set name2 $name
			}
			if {!([string equal {Mark} $fieldName] && [string equal {Conference Proceedings} $referenceType])} {
				set "controlArray(displayTable($referenceType,$referFieldName))" [list $fieldType $fieldRequired$fieldHelp {} $name2]
			} else {
# mark field and Conference Proceedings reference type
				set {controlArray(displayTable(Conference Proceedings,%@mark))} "\[expr \[lsearch -index 1 \$supervisorList \$userName\] == -1?{\[list [list 4 {} {} $name2]\]}:{\[list [list $fieldType $fieldRequired$fieldHelp {} $name2]\]}\]"	;# added by GJFB on 2016-06-05 - subst added to solve a conditonal display of the mark field in Conference Proceeding form based on a list of supervisors (see SetFieldProperties) - subst is needed when using metaforms, e.g., when displayTable contains expression like: {[expr [lsearch -index 1 $supervisorList $userName] == -1?{[list 0 {} {} {}]}:{[list 3 {} {} {Recomendação do orientador}]}]}
			}
		} else {
			set "controlArray(displayTable($referenceType,$referFieldName))" {0 {} {} {}}
		}
}

# SetFieldProperties - end
# ----------------------------------------------------------------------
# ComputeStatistics
# searchExpressionList examples:
# {floresta} {ref thesis and ar SRE and y 2000|* and - florest*} {agricultura} {ref thesis and ar SRE and y 2000|* and - agricultur*} {geologia} {ref thesis and ar SRE and y 2000|* and - geolog*} {outros} {ref thesis and ar SRE and y 2000|* and not k geolog* and not k florest* and not k agricultur*}
# {conference} {ref conference} {report} {ref report}
# for an example of use in a Tcl Page see: http://urlib.net/sid.inpe.br/bibdigital@80/2007/02.16.13.54

proc ComputeStatistics {searchExpressionList} {
	global env
	global currentRep
	global language

#	package require http

# repository2siteArray (each repository entry maps to a list of sites)
# repository2subjectArray (each repository entry maps to a list of subjects)
# repository2titleArray (each repository entry maps to a title)
	array sSetFieldPropertieset searchExpressionArray $searchExpressionList
	foreach subject [array names searchExpressionArray] {
		set query $searchExpressionArray($subject)
		foreach item [FindMetadataRepositories $query 0 {} {} no no 1] {
			foreach {site rep-i} $item {break}
			SetFieldValue $site ${rep-i} {repository title}
			if [string equal {} $repository] {continue}
			lappend repository2siteArray($repository) $site
			lappend repository2subjectArray($repository) $subject
			if ![info exists repository2titleArray($repository)] {set repository2titleArray($repository) $title}
		}
	}

# today
	set today [clock format [clock seconds] -format %Y.%m.%d]
	set todayNOD [ComputeNOD $today]

	foreach rep [array names repository2siteArray] {

 		set path [file split $rep]
		set year [lindex $path 2]
		set rest [lreplace $path 2 2]
		regsub -all { } $rest {=} rest
 
		set totalNumberOfVisits 0
		set numberOfVisitsList {}
		set smallerFirstDay $today
		foreach site [lsort -unique $repository2siteArray($rep)] {
if 1 {
			set command [list list GetDocAccessLogFileContent $rep]
			set fileContent [MultipleExecute [list $site] $command]
			if [string equal {} $fileContent] {continue}	;# the site doesn't contain the original

			set numberOfVisits 0
			foreach line $fileContent {
#				set numberOfClicks 1
				set numberOfClicks 0
				regexp {(.*)-(.*)} $line m day numberOfClicks
# SUM UP
				set numberOfVisits [expr $numberOfClicks + $numberOfVisits]
			}
			set firstLine [lindex [split $fileContent \n] 0]
			set firstDay [lindex [split $firstLine -] 0]
			set smallerFirstDay [StringMin $smallerFirstDay $firstDay]
			set localSite [ReturnHTTPHost $site]
} else {
# not used - old code
			set localSite [ReturnHTTPHost $site]
			set numberOfVisits 0
#			foreach indexRep $site2indexRepArray($site) #
#				catch {http::geturl [ConvertURLToHexadecimal "http://$localSite/col/$indexRep/doc/access/$year/$rest"]} token
				catch {http::geturl [ConvertURLToHexadecimal "http://$localSite/col/$env(LOCOINREP)/doc/access/$year/$rest"]} token
				if ![regexp {200 OK} [http::code $token]] {
# file not found
					continue
				} else {
					set fileContent [string trim [http::data $token]]
					foreach line [split $fileContent \n] {
						set numberOfClicks 1
						regexp {(.*)-(.*)} $line m day numberOfClicks
# SUM UP
						set numberOfVisits [expr $numberOfClicks + $numberOfVisits]
					}
					set firstLine [lindex [split $fileContent \n] 0]
					set firstDay [lindex [split $firstLine -] 0]
					set smallerFirstDay [StringMin $smallerFirstDay $firstDay]
				}
				http::cleanup $token
			#
}
# SUM UP
			set totalNumberOfVisits [expr $numberOfVisits + $totalNumberOfVisits]
			lappend numberOfVisitsList "<A HREF=\"http://$localSite/statistics.cgi/$rep?languagebutton=$language\" TARGET=_blank>$numberOfVisits</A>"
		}
		set title "<A HREF=\"http://$env(SERVER_NAME):$env(SERVER_PORT)/col/$currentRep/doc/mirrorsearch.cgi?query=repos+$rep\" TARGET=_blank>[join $repository2titleArray($rep)]</A>"
# numberOfDays
		set firstAccessNOD [ComputeNOD $smallerFirstDay]
		set numberOfDays [expr $todayNOD - $firstAccessNOD + 1]
# average
		set average [format "%4.2f" [expr $totalNumberOfVisits. / $numberOfDays]]
		if [string equal {} $numberOfVisitsList] {
			set totalNumberOfVisits2 "$totalNumberOfVisits&nbsp;=&nbsp;0"	;# 0
		} else {
			set totalNumberOfVisits2 "$totalNumberOfVisits&nbsp;=&nbsp;[join $numberOfVisitsList {&nbsp;+&nbsp;}]"
		}
		regsub -all {\.} $smallerFirstDay {\.} dayOfTheFirstVisit
		lappend dataList [list $title $average $totalNumberOfVisits2 $dayOfTheFirstVisit $repository2subjectArray($rep)]
	}
	return [lsort -index 1 -dictionary -decreasing $dataList]
}

# ComputeStatistics - end
# ----------------------------------------------------------------------
# ReturnAttributeValue
# used in Submit, Script (iconet.com.br/banon/2007/01.01.16.00)
# and importar_cvlattes.tcl (dpi.inpe.br/lise/2008/05.08.14.01)
# tableParameters value is for example: year=2008
# mappingDomainName value is for example: journal or author
# attributeName value example for journal: dissimination
# attributeName value example for author: group
# inputFieldValue value is for example: Agriculture,_Ecosystems_and_Environment
# domainFlag value is 0 or 1
# 0 means to return the current attribute value (e.g., 1 3) using ReturnAttributeValue2
# 1 means to return the attribute value domain (in case of check box - e.g., 1 2 3 4 5)
# 1 means to return empty (otherwise)

proc ReturnAttributeValue {
	tableParameters mappingDomainName attributeName inputFieldValue {domainFlag 0}
} {
	upvar displayTable displayTable	;# set in displayControl.tcl
	upvar attributeTable attributeTable	;# set when executing eval $sourceDisplayControl
	upvar boxTable boxTable
if 1 {	
	if ![llength [array names attributeTable $tableParameters,$mappingDomainName,$attributeName,*]] {
		error "ReturnAttributeValue: no inputs of the type $tableParameters,$mappingDomainName,$attributeName,* were found in attributeTable"
	}
# puts $tableParameters
# puts $inputFieldValue
# puts --[array names attributeTable]--
# fieldTypeNumber
	if [info exists displayTable($mappingDomainName,$attributeName)] {
		set fieldTypeNumber [lindex $displayTable($mappingDomainName,$attributeName) 0]
	} else {
		set fieldTypeNumber 0
	}
	if $domainFlag {
		set outputFieldValue {}
		if {$fieldTypeNumber == 2.2} {
# check box
# used with repository: iconet.com.br/banon/2007/01.01.16.00 (see col/dpi.inpe.br/banon-pc3/2012/12.26.12.33/doc/displayControl.tcl)
			foreach item $boxTable($mappingDomainName,$attributeName) {
				lappend outputFieldValue [lindex $item 0]
			}
		}
	} else {
# set {attributeTable(year=2007,journal,dissemination,Agriculture,_Ecosystems_and_Environment)} {WEBSCI PORTALCAPES}
		set outputFieldValue [ReturnAttributeValue2 $tableParameters $mappingDomainName $attributeName $inputFieldValue]
		if {$fieldTypeNumber == 2.2} {
# check box
# used with repository: iconet.com.br/banon/2007/01.01.16.00 (see col/dpi.inpe.br/banon-pc3/2012/12.26.12.33/doc/displayControl.tcl)
			if {[llength $outputFieldValue] > 1} {
				set outputFieldValue [join $outputFieldValue {; }].	;# solving check box type entry
			}
		}
	}
} else {
	regexp {year=(\d{4,})} $tableParameters m year
	if {[string equal {author} $mappingDomainName] && [string equal {group} $attributeName] && [string equal [clock format [clock seconds] -format %Y] $year]} {	
		set outputFieldValue {}
		if [string equal {} $outputFieldValue] {
# try from author to group using INPE Web-Service 
			package require http
#			http://mtc-m21b.sid.inpe.br/dpi.inpe.br/banon-pc.1905/2013/11.19.13.01?author=Gerald+Jean+Francis+Banon
			set inputFieldValue2 [join [FormatAuthorName [list $inputFieldValue] {} familynamelast]]
# puts $inputFieldValue2
#			if [catch {http::geturl [ConvertURLToHexadecimal http://www.urlib.net/dpi.inpe.br/banon-pc.1905/2013/11.19.13.01?author=$inputFieldValue2]} token] #
			if [catch {http::geturl [ConvertURLToHexadecimal http://mtc-m21b.sid.inpe.br/col/dpi.inpe.br/banon-pc.1905/2013/11.19.13.01/doc/index.php?author=$inputFieldValue2]} token] {
			} else {
				set data [http::data $token]
				http::cleanup $token
				regexp "<body>(.*)</body>" $data m outputFieldValue
				set outputFieldValue [string trim $outputFieldValue]
				if [string equal {not found} $outputFieldValue] {
					set outputFieldValue {}
				}
			}		
		}
	}
}
# puts --$outputFieldValue--<BR>
	return $outputFieldValue
}

# ReturnAttributeValue - end
# ----------------------------------------------------------------------
# ReturnAttributeValue2
# used in ReturnAttributeValue and Submit only

proc ReturnAttributeValue2 {tableParameters mappingDomainName attributeName inputFieldValue} {
	upvar attributeTable attributeTable

	if [string equal {issn} $mappingDomainName] {
# multi-valued field
		set outputFieldValue {}
		foreach item $inputFieldValue {
			if [info exists attributeTable($tableParameters,$mappingDomainName,$attributeName,$item)] {
# SET
				set outputFieldValue $attributeTable($tableParameters,$mappingDomainName,$attributeName,$item)
				break
			}
		}
	} else {
# puts $inputFieldValue
#		regsub -all { } $inputFieldValue {_} inputFieldValue2	;# Sandri, Sandra  Aparecida, -> Sandri,_Sandra__Aparecida,
		regsub -all {\s+} $inputFieldValue {_} inputFieldValue2	;# Sandri, Sandra  Aparecida, -> Sandri,_Sandra_Aparecida,
# SET
# example:
# name												value
# year=2015,author,group,ACIOLI_ANTONIO_DE_OLIVO	DIR-DIR-INPE-MCTI-GOV-BR
		ConditionalSet outputFieldValue attributeTable($tableParameters,$mappingDomainName,$attributeName,$inputFieldValue2) {}
#		if [string equal {} $outputFieldValue] #	;# commented by GJFB on 2011-03-14
#		if {[string equal {} $outputFieldValue] && [string equal {author} $mappingDomainName]} #	;# commented by GJFB on 2011-06-10
		if {[string equal {} $outputFieldValue] && [regexp {author} $mappingDomainName]} {
# author or firstauthor
			set outputFieldValue [ReturnAttributeValue3 $tableParameters $mappingDomainName $attributeName $inputFieldValue2]
			if [string equal {} $outputFieldValue] {
# try family name last
				set inputFieldValue2 [join [FormatAuthorName [list $inputFieldValue] {} familynamelast]]		;# family name first -> family name last - needed with INPE administrator tables
# puts $inputFieldValue2
#				regsub -all { } $inputFieldValue2 {_} inputFieldValue3	;# Sandra  Aparecida Sandri -> Sandra__Aparecida_Sandri
				regsub -all {\s+} $inputFieldValue2 {_} inputFieldValue3	;# Sandra  Aparecida Sandri -> Sandra_Aparecida_Sandri
# SET
# puts 1-$inputFieldValue3
				set outputFieldValue [ReturnAttributeValue3 $tableParameters $mappingDomainName $attributeName $inputFieldValue3]
# puts 2-$outputFieldValue
			}
		}
	}
	return $outputFieldValue
}		

# ReturnAttributeValue2 - end
# ----------------------------------------------------------------------
# ReturnAttributeValue3
# used in ReturnAttributeValue2 only
# used in ReturnAttributeValue2 when $mappingDomainName == author or firstauthor

proc ReturnAttributeValue3 {tableParameters mappingDomainName attributeName inputFieldValue} {
	upvar attributeTable attributeTable

# try upper
	set inputFieldValue2 [string toupper $inputFieldValue]
# puts $inputFieldValue2
# SET
	ConditionalSet outputFieldValue attributeTable($tableParameters,$mappingDomainName,$attributeName,$inputFieldValue2) {}
	if [string equal {} $outputFieldValue] {
# try without accent
# Drop accent
		set inputFieldValue3 [DropAccent $inputFieldValue2]
# Drop accent - end
		regsub -all {'} $inputFieldValue3 {} inputFieldValue3	;# SANT'ANNA -> SANTANNA
# SET
		ConditionalSet outputFieldValue attributeTable($tableParameters,$mappingDomainName,$attributeName,$inputFieldValue3) {}
	}
	return $outputFieldValue
}		

# ReturnAttributeValue3 - end
# ----------------------------------------------------------------------
# DropAccent
# used in ReturnAttributeValue3 and Script (in dpi.inpe.br/banon-pc@1905/2005/02.19.00.40) only

proc DropAccent {string} {
	global accentTable2
	
	set letterList [split $string {}]
	set letterList2 {}
	foreach letter $letterList {
		if [info exists accentTable2($letter)] {
		   lappend letterList2 $accentTable2($letter)
		} else {
		   lappend letterList2 $letter
		}
	}
	return [join $letterList2 {}]
}		

# DropAccent - end
# ----------------------------------------------------------------------
# UpdateMetadataEntryList
# updates the list called fieldListName
# set the value of the field named fieldName to newFieldValue
# >>> the field named fieldName must NOT be a multiple field (if it is - like issn - it must assume only one value)
# if the fieldName already exists, then it updated, otherwise it is added
# if the newFieldValue is empty the field is deleted
# examples:
# UpdateMetadataEntryList metadataEntryList %@documentstage $nextUser
# UpdateMetadataEntryList metadataEntryList2 $attributeReferName $fieldValue 1
# used in Submit and LoadMetadata
# syntax value is 0 or 1
# 1 means to set newFieldValue between brackets
# syntax == 0 => %T Tt tt 
# syntax == 1 => %T {Tt tt} 
# example of fieldListName:
# {%@mirrorrepository iconet.com.br/banon/2006/11.26.21.31} {%8 {}} {%N {}} {%T {Testando formulário de submissão}} {%@electronicmailaddress {}} {%@secondarytype {PRE PI}} {%@archivingpolicy {}} {%@usergroup banon} {%@group DPI-OBT-INPE-MCTI-GOV-BR} {%@e-mailaddress {}} {%3 {}} {%@copyholder {}} {%@secondarykey INPE--PRE/} {%@secondarymark {B2_BIOTECNOLOGIA B2_CIÊNCIAS_BIOLÓGICAS_I B3_CIÊNCIAS_BIOLÓGICAS_III B1_MEDICINA_I B1_MEDICINA_II B1_MEDICINA_VETERINÁRIA A2_ZOOTECNIA_/_RECURSOS_PESQUEIROS}} {%U {}} {%@issn 0300-9858} {%2 urlib.net/www/2013/01.20.23.46.36} {%@affiliation {{Instituto Nacional de Pesquisas Espaciais (INPE)}}} {%@project {}} {%B {Veterinary Pathology}} {%@versiontype publisher} {%P {}} {%4 urlib.net/www/2013/01.20.23.46} {%@documentstage {not transferred}} {%D 2012} {%V 92} {%@doi {}} {%A {{Banon, Gerald Jean Francis,}}} {%@rightsholder {}} {%@area SRE}

proc UpdateMetadataEntryList {fieldListName fieldName newFieldValue {syntax 0}} {
	upvar $fieldListName fieldList

	set metadataEntryList2 {}
	set flag 1
	foreach item $fieldList {
# doesn't work
#		set fieldName [lindex $item 0]
#		set fieldValue [lrange $item 1 end]	;# doesn't work, loose quote, eg., a "lua" -> a lua or produces a 'list element in quotes followed by "." instead of space' (eg., a "lua".)
## see other solution in UpdateRefer
		if [regexp {^([^ ]*) (.*)$} $item m fieldName2 fieldValue] {
			if [string equal $fieldName $fieldName2] {
				set flag 0
				if [string equal {} $newFieldValue] {continue}
				if $syntax {
					lappend metadataEntryList2 [list $fieldName $newFieldValue]
				} else {
					lappend metadataEntryList2 "$fieldName $newFieldValue"
				}
			} else {
				lappend metadataEntryList2 $item	;# nothing to do
			}
		} else {
# just the field name (for example when fieldList contains some empty values within a multiple field)
			if $syntax {
				lappend metadataEntryList2 [list $item {}]
			} else {
				lappend metadataEntryList2 $item
			}
		}
	}
	if {$flag && ![string equal {} $newFieldValue]} {
# add a new field name
		if $syntax {
			lappend metadataEntryList2 [list $fieldName $newFieldValue]
		} else {
			lappend metadataEntryList2 "$fieldName $newFieldValue"
		}
	}
	set fieldList $metadataEntryList2
}

# UpdateMetadataEntryList - end
# ----------------------------------------------------------------------
# Identity

proc Identity {x} {
	return $x
}

# Identity - end
# ----------------------------------------------------------------------
# Identity2
# used in TestExecute (in test2.tcl) only for testing communication

proc Identity2 {remoteServerAddress x} {
	set query [list list Identity $x]
	return [MultipleExecute [list $remoteServerAddress] $query 1]
}

# Identity - end
# ----------------------------------------------------------------------
# BinaryAnd

proc BinaryAnd {a b} {
	if [regexp {^0*$} $a] {return 0}
		set i 0
	set bs [split $b {}]
	foreach bit [split $a {}] {
		lappend c [expr {$bit & [lindex $bs $i]}]
		incr i
	}
	return [join $c {}]
}

# BinaryAnd - end
# ----------------------------------------------------------------------
# BinaryLess

proc BinaryLess {a b} {
	if [regexp {^0*$} $a] {return 0}
	set i 0
	set bs [split $b {}]
	foreach bit [split $a {}] {
		lappend c [expr {$bit < [lindex $bs $i]}]
		incr i
	}
	return [join $c {}]
}

# BinaryLess - end
# ----------------------------------------------------------------------
# BinaryExclusiveOr

proc BinaryExclusiveOr {a b} {
	if [regexp {^0*$} $a] {return $b}
	set i 0
	set bs [split $b {}]
	foreach bit [split $a {}] {
		lappend c [expr {$bit ^ [lindex $bs $i]}]
		incr i
	}
	return [join $c {}]
}

# BinaryExclusiveOr - end
# ----------------------------------------------------------------------
# BinaryAddition

proc BinaryAddition {a b} {
	set aLength [string length $a]
	set bLength [string length $b]
	if [set count [expr {$aLength - $bLength}]] {set b [string repeat 0 $count]$b}
	if [set count [expr {$bLength - $aLength}]] {set a [string repeat 0 $count]$a}
	return [BinaryAddition2 $a $b]
	set c [BinaryAddition2 $a $b]
	set bLength [string length $b]
	set first [expr {[string length $c] - $bLength - 1}]
	if ![string index $c $first] {incr first}
	return [string range $c $first end]
}

# BinaryAddition - end
# ----------------------------------------------------------------------
# BinaryAddition2

proc BinaryAddition2 {a b} {
	set exclusiveOr [BinaryExclusiveOr $a $b]
	set and [BinaryAnd $a $b]
	if [regexp {^0*$} $and] {
		if [regexp {^0*$} $exclusiveOr] {return 0} else {return [string trimleft $exclusiveOr 0]}
	}
	return [BinaryAddition2 0$exclusiveOr ${and}0]
}

# BinaryAddition2 - end
# ----------------------------------------------------------------------
# BinaryMultiplication

proc BinaryMultiplication {a b} {
	set c {}
	set trailingZero {}
	set i [string length $b]
	foreach bit [split $b {}] {
		incr i -1
		if [string index $b $i] {set c [BinaryAddition 0$c $a$trailingZero]} else {set c 0$c}
		append trailingZero 0
	}
	return $c
}

# BinaryMultiplication - end
# ----------------------------------------------------------------------
# DecimalPower
# appropriate when working with unlimited inter range
# a must be integer

proc DecimalPower {a b} {
	set c 1
	for {set i 1} {$i <= $b} {incr i} {
		set c [expr $a * $c]
	}
	return $c
}

# DecimalPower - end
# ----------------------------------------------------------------------
# BinaryPower

proc BinaryPower {a b} {
	set c 1
	for {set i 1} {$i <= $b} {incr i} {
		set c [BinaryMultiplication $a $c]
	}
	return $c
}

# BinaryPower - end
# ----------------------------------------------------------------------
# BinarySubtraction

proc BinarySubtraction {a b} {
# it is assumed that a >= b and length of a >= length of b
	set aLength [string length $a]
	set bLength [string length $b]
	if [set count [expr {$aLength - $bLength}]] {set b [string repeat 0 $count]$b}
	return [BinarySubtraction2 $a $b]
	set c [BinarySubtraction2 $a $b]
	set first [expr {[string length $c] - $aLength}]
	return [string range $c $first end]
}

# BinarySubtraction - end
# ----------------------------------------------------------------------
# BinarySubtraction2

proc BinarySubtraction2 {a b} {
	set exclusiveOr [BinaryExclusiveOr $a $b]
	set less [BinaryLess $a $b]
	if [regexp {^0*$} $less] {
		if [regexp {^0*$} $exclusiveOr] {return 0} else {return [string trimleft $exclusiveOr 0]}
	}
	return [BinarySubtraction2 0$exclusiveOr ${less}0]
}

# BinarySubtraction2 - end
# ----------------------------------------------------------------------
# BinaryDivision

proc BinaryDivision {a b} {
	set aLength [string length $a]
	set bLength [string length $b]
	if {$aLength < $bLength} {return [list 0 $a]}
	set x [string range $a 0 [expr {$bLength - 1}]]
	set quotient {}
	for {set i $bLength} {$i <= $aLength} {incr i} {
		if {$x >= $b} {
			set remainder [BinarySubtraction $x $b]
			append quotient 1
		} else {
			set remainder $x
			append quotient 0
		}
		set x $remainder[string index $a $i]
		set x [string trimleft $x 0]
	}
	if [regexp {^0*$} $quotient] {set quotient 0} else {set quotient [string trimleft $quotient 0]}
	if [regexp {^0*$} $remainder] {set remainder 0} else {set remainder [string trimleft $remainder 0]}
	return [list $quotient $remainder]
}

# BinaryDivision - end
# ----------------------------------------------------------------------
# CreateWritingDigitList

proc CreateWritingDigitList {upperCaseOnly} {
	if $upperCaseOnly {
# case-insensitive (used by ConvertFromRepository)
# 0 1 I O Z are not used
# W is used to code "a"
# X Y V are used as separators (. @ /)
# ex.: ---X----X--V---------Y---/------

# case-insensitive identifier from IP
# 0 1 I O V X Y Z are not used
# W is used as separator between a coded IPv4 and a coded port (instead of V, because V looks like U)
# ex.: ---------W---/-------
# X is used as separator between a coded IPv6 and a coded port
# ex.: ---------X---/-------
		set digitList {
			0	   	2
			1 	   	3
			10	   	4
			11 	  	5
			100   	6
			101   	7
			110   	8
			111   	9 
			1000  	A
			1001  	B
			1010   	C
			1011   	D
			1100   	E
			1101   	F
			1110   	G
			1111   	H
			10000  	J
			10001  	K
			10010  	L
			10011  	M
			10100  	N
			10101  	P
			10110  	Q
			10111  	R
			11000  	S
			11001  	T
			11010  	U
		}
	} else {
# case-sensitive (used by ConvertFromRepository)
# 0 1 l I O are not used
## W is used to code "a"
# X Y Z are used as separators (. @ /)
# ex.: ---X----X-Z--------Y--/-----

# case-sensitive identifier from IP
# 0 1 l I O W X Y are not used
# W is used to code "a"
# Z is used as separator between a coded IPv4 and a coded port
# ex.: ---------Z---/-------
# Y is used as separator between a coded IPv6 and a coded port
# ex.: ---------Y---/-------
		set digitList {
			0	   	2
			1 	   	3
			10	   	4
			11 	  	5
			100   	6
			101   	7
			110   	8
			111   	9 
			1000  	a
			1001  	b
			1010   	c
			1011   	d
			1100   	e
			1101   	f
			1110   	g
			1111   	h
			10000  	i
			10001  	j
			10010  	k
			10011  	m
			10100  	n
			10101  	o
			10110  	p
			10111  	q
			11000  	r
			11001  	s
			11010  	t
			11011  	u
			11100  	v
			11101  	w
			11110  	x
			11111  	y
			100000 	z
			100001 	A
			100010 	B
			100011 	C
			100100 	D
			100101 	E
			100110 	F
			100111 	G
			101000 	H
			101001 	J
			101010 	K
			101011  L
			101100  M
			101101  N
			101110  P
			101111  Q
			110000  R
			110001  S
			110010  T
			110011  U
			110100  V
		}
	}
	return $digitList
}

# CreateWritingDigitList - end
# ----------------------------------------------------------------------
# CreateWritingDigitListFromDecimal

proc CreateWritingDigitListFromDecimal {upperCaseOnly} {
	if $upperCaseOnly {
# case-insensitive (used by ConvertFromRepository)
# 0 1 I O Z are not used
# W is used to code "a"
# X Y V are used as separators instead of . @ /
# ex.: ---X----X--V---------Y---/------

# case-insensitive identifier from IP
# 0 1 I O V Y Z are not used
# W is used as separator between a coded IPv4 and a coded port (instead of V, because V looks like U)
# ex.: ---------W---/-------
# X is used as separator between a coded IPv6 and a coded port
# ex.: ---------X---/-------
		set digitList {
			0	   	2
			1 	   	3
			2	   	4
			3 	  	5
			4   	6
			5   	7
			6   	8
			7   	9 
			8 	 	A
			9	  	B
			10   	C
			11   	D
			12   	E
			13   	F
			14   	G
			15   	H
			16  	J
			17  	K
			18  	L
			19  	M
			20  	N
			21  	P
			22  	Q
			23  	R
			24  	S
			25  	T
			26  	U
		}
	} else {
# case-sensitive (used by ConvertFromRepository)
# 0 1 l I O are not used
## W is used to code "a"
# X Y Z are used as separators instead of . @ /
# ex.: ---X----X-Z--------Y--/-----

# case-sensitive identifier from IP
# 0 1 l I O W X are not used
# W is used to code "a"
# Z is used as separator between a coded IPv4 and a coded port
# ex.: ---------Z---/-------
# Y is used as separator between a coded IPv6 and a coded port
# ex.: ---------Y---/-------
		set digitList {
			0	   	2
			1 	   	3
			2	   	4
			3 	  	5
			4   	6
			5   	7
			6   	8
			7   	9 
			8	  	a
			9	  	b
			10   	c
			11   	d
			12   	e
			13   	f
			14   	g
			15   	h
			16  	i
			17  	j
			18  	k
			19  	m
			20  	n
			21  	o
			22  	p
			23  	q
			24  	r
			25  	s
			26  	t
			27  	u
			28  	v
			29  	w
			30  	x
			31  	y
			32	 	z
			33	 	A
			34	 	B
			35	 	C
			36	 	D
			37	 	E
			38	 	F
			39	 	G
			40	 	H
			41 		J
			42	 	K
			43		L
			44		M
			45		N
			46		P
			47		Q
			48		R
			49		S
			50		T
			51		U
			52		V
		}
	}
	return $digitList
}

# CreateWritingDigitListFromDecimal - end
# ----------------------------------------------------------------------
# CreateReadingDigitList

proc CreateReadingDigitList {{x x}} {
# x argument is not used inside CreateReadingDigitList but is needed outside for syntax reason
	set digitList {
		0		a
		1 		b
		10		c	
		11 		o
		100 	i
		101 	e
		110 	m
		111 	n
		1000 	u
		1001 	s
		1010 	r
		1011 	l
		1100 	d
		1101 	f
		1110 	p
		1111 	t
		10000 	v
		10001 	g
		10010 	y
		10011 	h
		10100 	k
		10101 	w
		10110 	x
		10111 	j
		11000 	q
		11001 	z
		11010 	0
		11011 	1
		11100 	2
		11101 	3
		11110 	4
		11111 	5
		100000 	6
		100001 	7
		100010 	8
		100011 	9
		100100 	- 
	}
	return $digitList
}

# CreateReadingDigitList - end
# ----------------------------------------------------------------------
# CreateReadingIPDigitList
# dot-decimal notation for IPv4

proc CreateReadingIPDigitList {{x x}} {
# x argument is not used inside CreateReadingIPDigitList but is needed outside for syntax reason
	set digitList {
		0		0
		1 		1
		10		2	
		11 		3
		100 	4
		101 	5
		110 	6
		111 	7
		1000 	8
		1001 	9
		1010 	.
	}
	return $digitList
}

# CreateReadingIPDigitList - end
# ----------------------------------------------------------------------
# CreateReadingIPDigitListToDecimal
# dot-decimal notation for IPv4

proc CreateReadingIPDigitListToDecimal {{x x}} {
# x argument is not used inside CreateReadingIPDigitListToDecimal but is needed outside for syntax reason
	set digitList {
		0		0
		1 		1
		2		2	
		3 		3
		4	 	4
		5 		5
		6	 	6
		7	 	7
		8	 	8
		9	 	9
		10	 	.
	}
	return $digitList
}

# CreateReadingIPDigitListToDecimal - end
# ----------------------------------------------------------------------
# CreateReadingIPv6DigitList
# colon-hexadecimal notation for IPv6

proc CreateReadingIPv6DigitList {{x x}} {
# x argument is not used inside CreateReadingIPv6DigitList but is needed outside for syntax reason
	set digitList {
		0		0
		1 		1
		10		2	
		11 		3
		100 	4
		101 	5
		110 	6
		111 	7
		1000 	8
		1001 	9
		1010 	a
		1011 	b
		1100 	c
		1101 	d
		1110 	e
		1111 	f
		10000 	:
	}
	return $digitList
}

# CreateReadingIPv6DigitList - end
# ----------------------------------------------------------------------
# CreateReadingIPv6DigitListToDecimal
# colon-hexadecimal notation for IPv6

proc CreateReadingIPv6DigitListToDecimal {{x x}} {
# x argument is not used inside CreateReadingIPv6DigitListToDecimal but is needed outside for syntax reason
	set digitList {
		0		0
		1 		1
		2		2	
		3 		3
		4	 	4
		5	 	5
		6	 	6
		7	 	7
		8	 	8
		9	 	9
		10	 	a
		11		b
		12	 	c
		13	 	d
		14	 	e
		15	 	f
		16	 	:
	}
	return $digitList
}

# CreateReadingIPv6DigitListToDecimal - end
# ----------------------------------------------------------------------
# ConvertFromDecimal
# example:
# ConvertFromDecimal $input $upperCaseOnly
# ConvertFromDecimal 1 1
# => 3
# ConvertFromDecimal 19050 1
# => U5H

proc ConvertFromDecimal {input upperCaseOnly {listType CreateWritingDigitListFromDecimal}} {
	set digitList [eval $listType $upperCaseOnly]
	set baseSize [expr [llength $digitList] / 2]
	array set digitArray $digitList
	return [ConvertFromDecimal2 $input $baseSize]
}

# ConvertFromDecimal - end
# ----------------------------------------------------------------------
# ConvertFromDecimal2

proc ConvertFromDecimal2 {input baseSize} {
	upvar digitArray digitArray
	set quotient $input
	set output {}
	if {[info tclversion] > 8.4} {
# entier works with unlimited integer range - added by GJFB on 2010-10-23
		while {$quotient != 0} {
			set output [concat $digitArray([expr {$quotient % $baseSize}]) $output]
#			set quotient [expr {entier($quotient / $baseSize)}]	;# interpretation fails with tcl 8.4 - commented by GJFB on 2010-10-23
			set quotient [expr entier($quotient / $baseSize)]	;# added by GJFB on 2010-10-23
		}
	} else {
# int truncates range to fit in particular storage widths
		while {$quotient != 0} {
			set output [concat $digitArray([expr {$quotient % $baseSize}]) $output]
			set quotient [expr {int($quotient / $baseSize)}]
		}
	}
	return [join $output {}]	
}

# ConvertFromDecimal2 - end
# ----------------------------------------------------------------------
# ConvertFromBinary

proc ConvertFromBinary {input upperCaseOnly {listType CreateWritingDigitList}} {
	set digitList [eval $listType $upperCaseOnly]
	set baseSize [ConvertDecimalToBinary [expr [llength $digitList] / 2]]
	array set digitArray $digitList
	return [ConvertFromBinary2 $input $baseSize]
}

# ConvertFromBinary - end
# ----------------------------------------------------------------------
# ConvertFromBinary2

proc ConvertFromBinary2 {input baseSize} {
	upvar digitArray digitArray
	set quotient $input
	set output {}
	while {![regexp {^0*$} $quotient]} {
		foreach {quotient remainder} [BinaryDivision $quotient $baseSize] {break}
		set output [concat $digitArray($remainder) $output]
	}
	return [join $output {}]
	
}

# ConvertFromBinary2 - end
# ----------------------------------------------------------------------
# ConvertDecimalToBinary

proc ConvertDecimalToBinary {input} {
	set digitArray(0) 0
	set digitArray(1) 1
	return [ConvertFromDecimal2 $input 2]
}

# not used
proc ConvertDecimalToBinary2 {input} {
	set quotient $input
	set output {}
	while {$quotient != 0} {
		set output [concat [expr {$quotient % 2}] $output]
		set quotient [expr {int($quotient / 2)}]
	}
	return [join $output {}]
}

# ConvertDecimalToBinary - end
# ----------------------------------------------------------------------
# ConvertBinaryToDecimal

proc ConvertBinaryToDecimal {input} {	 
	set digitList {0 0 1 1}
	return [ConvertToDecimal2 $input 2]
}

# not used
proc ConvertBinaryToDecimal2 {input} {
	set output 0
	set i [string length $input]
	foreach bit [split $input {}] {
		incr i -1
#		set output [expr $output + $bit * int(pow(2,$i))]	;# doesn't work for high vlue of i - commented by GJFB on 2010-10-23
		set output [expr $output + $bit * [DecimalPower 2 $i]]	;# added by GJFB on 2010-10-23
	}
	return $output
}

# ConvertBinaryToDecimal
# ----------------------------------------------------------------------
# ConvertToDecimal
# example:
# ConvertToDecimal 150.163.2.174 1 CreateReadingIPDigitListToDecimal
# => 4588904456580
# ConvertToDecimal 112 1 CreateReadingIPDigitListToDecimal
# => 134 = 1 * 11^2 + 1 * 11^1 + 2 * 11^0
# ConvertToDecimal 10. 1 CreateReadingIPDigitListToDecimal
# => 131 = 1 * 11^2 + 0 * 11^1 + 10 * 11^0
# abc -> g(a) * 11^2 + g(b) * 11^1 + g(c) * 11^0
# where g is inverse of f given by CreateReadingIPDigitListToDecimal

proc ConvertToDecimal {input upperCaseOnly {listType CreateWritingDigitListFromDecimal}} {
	set digitList [eval $listType $upperCaseOnly]
	set baseSize [expr {[llength $digitList] / 2}]
	return [ConvertToDecimal2 $input $baseSize]
}

# ConvertToDecimal - end
# ----------------------------------------------------------------------
# ConvertToDecimal2
# used in ConvertToDecimal and ConvertBinaryToDecimal only

proc ConvertToDecimal2 {input baseSize} {
	upvar digitList digitList
	foreach {decimalValue digit} $digitList {
		set inverseDigitArray($digit) $decimalValue
	}
	set output 0
	set i [string length $input]
	foreach digit [split $input {}] {
		incr i -1
#		set output [expr $output + $inverseDigitArray($digit) * int(pow($baseSize,$i))]	;# int truncates range to fit in particular storage widths - commented by GJFB on 2010-10-23
#		set output [expr $output + $inverseDigitArray($digit) * entier(pow($baseSize,$i))]	;# pow works in float and not unlimited integer range - commented by GJFB on 2010-10-23
		set output [expr $output + $inverseDigitArray($digit) * [DecimalPower $baseSize $i]]	;# added by GJFB on 2010-10-23
	}
	return $output
}

# ConvertToDecimal2 - end
# ----------------------------------------------------------------------
# ConvertToBinary

proc ConvertToBinary {input upperCaseOnly {listType CreateWritingDigitList}} {
	set digitList [eval $listType $upperCaseOnly]
	set baseSize [ConvertDecimalToBinary [expr {[llength $digitList] / 2}]]
	foreach {binaryValue digit} $digitList {
		set inverseDigitArray($digit) $binaryValue
	}
	set output 0
	set i [string length $input]
	foreach digit [split $input {}] {
		incr i -1
		set output [BinaryAddition $output [BinaryMultiplication $inverseDigitArray($digit) [BinaryPower $baseSize $i]]]
	}
	return $output
}

# ConvertToBinary - end
# ----------------------------------------------------------------------
# ConvertFromRepository
# used in Get and UpdateRepMetadataRep for old repositories without IBIp or IBIn

proc ConvertFromRepository {rep {upperCaseOnly 0}} {
	if $upperCaseOnly {set separator V} else {set separator Z}
	regexp {([^/]*/[^/]*)/([^/]*/[^/]*)} $rep m prefix suffix
	set suffix2 [ConvertFromRepositorySuffix $suffix $upperCaseOnly $separator]
	regexp {([^/]*)/([^/]*)} $prefix m domainName actorName
	set codedDomainName [ConvertFromCaseInsensitiveString $domainName $upperCaseOnly]
	if [regexp {(.*)@(.*)} $actorName m hostName port] {
		set codedActorName [ConvertFromCaseInsensitiveString $hostName $upperCaseOnly]Y
		if ![string equal {80} $port] {
			set codedActorName $codedActorName[ConvertFromBinary [ConvertDecimalToBinary $port] $upperCaseOnly]
		}
	} else {
		set codedActorName [ConvertFromCaseInsensitiveString $actorName $upperCaseOnly]
	}
	set prefix2 ${codedDomainName}$separator$codedActorName
	return $prefix2/$suffix2
}

# ConvertFromRepository - end
# ----------------------------------------------------------------------
# ConvertFromRepositorySuffix
# gmt option was added in 2009-03-23

proc ConvertFromRepositorySuffix {repositorySuffix upperCaseOnly separator} {
	if [string equal {} $repositorySuffix] {return}	;# added by GJFB on 2026-04-11
	set year [lindex [file split $repositorySuffix] 0]
	set numberOfYearDigit [string length $year]
	regsub -all {\.|/} $repositorySuffix {} dateTime	;# 2010/10.28.01.04.22 -> 20101028010422
	set fractionOfSecond 0
	if ![regsub "^(.{$numberOfYearDigit}....)(....)$" $dateTime {\1T\200} ISODateTime] {
		if [regsub "^(.{$numberOfYearDigit}....)(......)$" $dateTime {\1T\2} ISODateTime] {
		} else {
			regexp "^(.{$numberOfYearDigit}....)(......)(.+)$" $dateTime m m1 m2 m3
			set ISODateTime ${m1}T$m2
			set fractionOfSecond $m3
		}
	}
# set ISODateTime
# => 20101028T010422
	set seconds [expr [clock scan $ISODateTime -gmt 1] - [clock scan 19950801T000000 -gmt 1]]	;# 807235200 seconds
	if {$seconds < 0} {return -code error -errorinfo {ConvertFromRepositorySuffix: repository name syntax error}}
	if $fractionOfSecond {
# suffix with fraction of second
		return [ConvertFromDecimal $seconds $upperCaseOnly]$separator[ConvertFromDecimal $fractionOfSecond $upperCaseOnly]
	} else {
# suffix without fraction of second
#		set suffix2 [ConvertFromBinary [ConvertDecimalToBinary $seconds] $upperCaseOnly]
		return [ConvertFromDecimal $seconds $upperCaseOnly]	;# added by GJFB on 2010-10-27 - faster
	}
}

# clock seconds
# 1288227862
# clock format 1288227862 -format %Y/%m.%d.%H.%M.%S -gmt 1
# 2010/10.28.01.04.22
# clock scan 20101028T010422 -gmt 1
# 1288227862
# clock scan 20101028T010422 -timezone :UTC
# 1288227862
# clock scan 20101028T010422Z
# 1288227862

# ConvertFromRepositorySuffix - end
# ----------------------------------------------------------------------
# ConvertFromCaseInsensitiveString

proc ConvertFromCaseInsensitiveString {string upperCaseOnly} {
	set codedString {}
	foreach part [split $string .] {
		regexp {(a*)(.*)} $part m part1 part2	:# a is coded zero (see CreateReadingDigitList) and must be treated differently when placed at the beginning
		regsub -all {a} $part1 {W} part1
		lappend codedString $part1[ConvertFromBinary [ConvertToBinary $part2 $upperCaseOnly CreateReadingDigitList] $upperCaseOnly]
	}
	return [join $codedString X]
}

# ConvertFromCaseInsensitiveString - end
# ----------------------------------------------------------------------
# ConvertFromIPString

proc ConvertFromIPString {string upperCaseOnly} {
	if {[info tclversion] > 8.4} {
# use decimal - faster - added by GJFB on 2010-10-23
		return [ConvertFromDecimal [ConvertToDecimal $string $upperCaseOnly CreateReadingIPDigitListToDecimal] $upperCaseOnly]
	} else {
# use binary - unlimited integer range doesn't exist before 8.5
		return [ConvertFromBinary [ConvertToBinary $string $upperCaseOnly CreateReadingIPDigitList] $upperCaseOnly]
	}
}

# ConvertFromIPString - end
# ----------------------------------------------------------------------
# ConvertFromIPv6String

proc ConvertFromIPv6String {string upperCaseOnly} {
	if {[info tclversion] > 8.4} {
# use decimal - faster - added by GJFB on 2010-10-23
		return [ConvertFromDecimal [ConvertToDecimal $string $upperCaseOnly CreateReadingIPv6DigitListToDecimal] $upperCaseOnly]
	} else {
# use binary - unlimited integer range doesn't exist before 8.5
		return [ConvertFromBinary [ConvertToBinary $string $upperCaseOnly CreateReadingIPv6DigitList] $upperCaseOnly]
	}
}

# ConvertFromIPv6String - end
# ----------------------------------------------------------------------
# ConvertFromPortString

proc ConvertFromPortString {string upperCaseOnly} {
#	return [ConvertFromBinary [ConvertDecimalToBinary $string] $upperCaseOnly]
	return [ConvertFromDecimal $string $upperCaseOnly]	;# added by GJFB on 2010-10-27 - faster
}

# ConvertFromPortString - end
# ----------------------------------------------------------------------
# ConvertToCaseInsensitiveIdentifier

proc ConvertToCaseInsensitiveIdentifier {ip urlibPort dateTime} {
	set upperCaseOnly 1
	if [string equal {800} $urlibPort] {
		set port {}
	} else {
#		set port [ConvertFromBinary [ConvertDecimalToBinary [expr $urlibPort - 800]] $upperCaseOnly]
#		set port [ConvertFromBinary [ConvertDecimalToBinary $urlibPort] $upperCaseOnly]	;# done by GJFB on 2010-07-31
		set port [ConvertFromPortString $urlibPort $upperCaseOnly]	;# done by GJFB on 2010-10-27
	}
	if [regexp {\.} $ip] {
# IPv4
		return [ConvertFromIPString $ip $upperCaseOnly]W$port/[ConvertFromRepositorySuffix $dateTime $upperCaseOnly W]
	} else {
# IPv6
		return [ConvertFromIPv6String $ip $upperCaseOnly]X$port/[ConvertFromRepositorySuffix $dateTime $upperCaseOnly X]
	}
}

# ConvertToCaseInsensitiveIdentifier - end
# ----------------------------------------------------------------------
# ConvertToCaseSensitiveIdentifier

proc ConvertToCaseSensitiveIdentifier {ip urlibPort dateTime} {
	set upperCaseOnly 0
	if [string equal {800} $urlibPort] {
		set port {}
	} else {
#		set port [ConvertFromBinary [ConvertDecimalToBinary [expr $urlibPort - 800]] $upperCaseOnly]
#		set port [ConvertFromBinary [ConvertDecimalToBinary $urlibPort] $upperCaseOnly]	;# done by GJFB on 2010-07-31
		set port [ConvertFromPortString $urlibPort $upperCaseOnly]	;# done by GJFB on 2010-10-27
	}
	if [regexp {\.} $ip] {
# IPv4
		return [ConvertFromIPString $ip $upperCaseOnly]Z$port/[ConvertFromRepositorySuffix $dateTime $upperCaseOnly Z]
	} else {
# IPv6
		return [ConvertFromIPv6String $ip $upperCaseOnly]Y$port/[ConvertFromRepositorySuffix $dateTime $upperCaseOnly Y]
	}
}

# ConvertToCaseSensitiveIdentifier - end
# ----------------------------------------------------------------------
# ConvertToRepository
# used just in ParseIBIURL for old repositories without IBIp
# used in ParseIBIURL 

proc ConvertToRepository {codedRep {upperCaseOnly 0}} {
	if $upperCaseOnly {set separator V} else {set separator Z}
	regexp {(.*)/(.*)} $codedRep m prefix suffix
	set suffix2 [ConvertToRepositorySuffix $suffix $upperCaseOnly $separator]
	regexp "(.*)${separator}(.*)" $prefix m codedDomainName codedActorName
	set domainName [ConvertToCaseInsensitiveString $codedDomainName $upperCaseOnly]
	if [regexp {(.*)Y(.*)} $codedActorName m codedHostName codedPort] {
		set actorName [ConvertToCaseInsensitiveString $codedHostName $upperCaseOnly]@
		if [string equal {} $codedPort] {
			set actorName ${actorName}80
		} else {
			set actorName $actorName[ConvertBinaryToDecimal [ConvertToBinary $codedPort $upperCaseOnly]]
		}
	} else {
		set actorName [ConvertToCaseInsensitiveString $codedActorName $upperCaseOnly]
	}
	set prefix2 $domainName/$actorName
	return $prefix2/$suffix2
}

# ConvertToRepository - end
# ----------------------------------------------------------------------
# ConvertToRepositorySuffix
# gmt option was added in 2009-03-23

proc ConvertToRepositorySuffix {suffix upperCaseOnly separator} {
	if {![set fractionOfSecond [regexp "(.*)${separator}(.*)" $suffix m suffix1 suffix2]]} {
# suffix without fraction of second
		set suffix1 $suffix
	}
#	set seconds [expr {[ConvertBinaryToDecimal [ConvertToBinary $suffix1 $upperCaseOnly]] + [clock scan 19950801T000000 -gmt 1]}]
	set seconds [expr {[ConvertToDecimal $suffix1 $upperCaseOnly] + [clock scan 19950801T000000 -gmt 1]}]
	set repositorySuffix1 [clock format $seconds -format "%Y/%m.%d.%H.%M.%S" -gmt 1]
	if $fractionOfSecond {
# suffix with fraction of second
		set repositorySuffix2 [ConvertToDecimal $suffix2 $upperCaseOnly]
		return $repositorySuffix1.$repositorySuffix2
	} else {
# suffix without fraction of second
		if ![string equal {BbsHa} $suffix] {	;# added by GJFB on 2021-03-08 to solve the wrong syntax of the repository dpi.inpe.br/banon/2004/02.16.09.30.00 (.00 should have been discarted in 2004 - this is a unique case)
			regsub {\.00$} $repositorySuffix1 {} repositorySuffix1
		}
		return $repositorySuffix1
	}
}
# ConvertToRepositorySuffix - end
# ----------------------------------------------------------------------
# ConvertToCaseInsensitiveString

proc ConvertToCaseInsensitiveString {codedString upperCaseOnly} {
	set string {}
	foreach part [split $codedString X] {
		regexp {(W*)(.*)} $part m part1 part2	:# a is coded zero (see CreateReadingDigitList) and must be treated differently when placed at the beginning
		regsub -all {W} $part1 {a} part1
		lappend string $part1[ConvertFromBinary [ConvertToBinary $part2 $upperCaseOnly] $upperCaseOnly CreateReadingDigitList]
	}
	return [join $string .]
}

# ConvertToCaseInsensitiveString - end
# ----------------------------------------------------------------------
# ConvertToIPString

proc ConvertToIPString {codedString upperCaseOnly} {
	if {[info tclversion] > 8.4} {
# use decimal - faster - added by GJFB on 2010-10-23
		return [ConvertFromDecimal [ConvertToDecimal $codedString $upperCaseOnly] $upperCaseOnly CreateReadingIPDigitListToDecimal]
	} else {
# use binary - unlimited integer range doesn't exist before 8.5
		return [ConvertFromBinary [ConvertToBinary $codedString $upperCaseOnly] $upperCaseOnly CreateReadingIPDigitList]
	}
}

# ConvertToIPString - end
# ----------------------------------------------------------------------
# ConvertToIPv6String

proc ConvertToIPv6String {codedString upperCaseOnly} {
	if {[info tclversion] > 8.4} {
# use decimal - faster - added by GJFB on 2010-10-23
		return [ConvertFromDecimal [ConvertToDecimal $codedString $upperCaseOnly] $upperCaseOnly CreateReadingIPv6DigitListToDecimal]
	} else {
# use binary - unlimited integer range doesn't exist before 8.5
		return [ConvertFromBinary [ConvertToBinary $codedString $upperCaseOnly] $upperCaseOnly CreateReadingIPv6DigitList]
	}
}

# ConvertToIPv6String - end
# ----------------------------------------------------------------------
# ConvertFromCaseInsensitiveIdentifier

proc ConvertFromCaseInsensitiveIdentifier {id} {
	set upperCaseOnly 1
	regexp {(.*)/(.*)} $id m prefix suffix
	regexp -nocase {(.*)([WX])(.*)} $prefix m codedIP separator codedPort
	set dateTime [ConvertToRepositorySuffix $suffix $upperCaseOnly $separator]
	if [string equal {W} $separator] {
# IPv4
		set ip [ConvertToIPString $codedIP $upperCaseOnly]
	} else {
# IPv6
		set ip [ConvertToIPv6String $codedIP $upperCaseOnly]
	}
	if [string equal {} $codedPort] {
		set urlibPort 800
	} else {
#		set urlibPort [expr [ConvertBinaryToDecimal [ConvertToBinary $codedPort $upperCaseOnly]] + 800]
#		set urlibPort [ConvertBinaryToDecimal [ConvertToBinary $codedPort $upperCaseOnly]]	;# done by GJFB on 2010-07-31
		set urlibPort [ConvertToDecimal $codedPort $upperCaseOnly]	;# done by GJFB on 2011-04-28
	}
	return [list $ip $urlibPort $dateTime]
}

# ConvertFromCaseInsensitiveIdentifier - end
# ----------------------------------------------------------------------
# ConvertFromCaseSensitiveIdentifier

proc ConvertFromCaseSensitiveIdentifier {id} {
	set upperCaseOnly 0
	regexp {(.*)/(.*)} $id m prefix suffix
	regexp -nocase {(.*)([ZY])(.*)} $prefix m codedIP separator codedPort
	set dateTime [ConvertToRepositorySuffix $suffix $upperCaseOnly $separator]
	if [string equal {Z} $separator] {
# IPv4
		set ip [ConvertToIPString $codedIP $upperCaseOnly]
	} else {
# IPv6
		set ip [ConvertToIPv6String $codedIP $upperCaseOnly]
	}
	if [string equal {} $codedPort] {
		set urlibPort 800
	} else {
#		set urlibPort [expr [ConvertBinaryToDecimal [ConvertToBinary $codedPort $upperCaseOnly]] + 800]
#		set urlibPort [ConvertBinaryToDecimal [ConvertToBinary $codedPort $upperCaseOnly]]	;# done by GJFB on 2010-07-31
		set urlibPort [ConvertToDecimal $codedPort $upperCaseOnly]	;# done by GJFB on 2011-04-28
	}
	return [list $ip $urlibPort $dateTime]
}

# ConvertFromCaseSensitiveIdentifier - end
# ----------------------------------------------------------------------
if 0 {
	source utilities1.tcl
	ConvertFromRepository iconet.com.br/banon/2001/02.10.22.55
# => CBnmVX32PXQZeBBx/p8N6G
##	ConvertToRepository CBnmVX32PXQZeBBx/p8LKL
	ConvertToRepository CBnmVX32PXQZeBBx/p8N6G
# => iconet.com.br/banon/2001/02.10.22.55
	ConvertFromRepository iconet.com.br/banon/2001/02.10.22.55 1
# => MJ9PM2X5SNX3NV5GM6L/E6H5HH
	ConvertFromRepositorySuffix 2001/02.10.22.55 1 1
# => E6H5HH
##	ConvertToRepository MJ9PM2X5SNX3NV5GM6L/E6GTK8 1
	ConvertToRepository MJ9PM2X5SNX3NV5GM6L/E6H5HH 1
	
	ConvertFromRepository cmm.ensmp.fr/decencie/1998/02.19.15.20
# => 34UX3eoDyXbgZUV5Sazq/cdM8w
	ConvertToRepository 34UX3eoDyXbgZUV5Sazq/cdM8w
# => cmm.ensmp.fr/decencie/1998/02.19.15.20
	
	ConvertFromRepository dpi.inpe.br/banon/2004/02.16.09.30.00
# => 83LX3pFwXQZeBBx/BbsHa
	ConvertFromRepository dpi.inpe.br/banon/2004/02.16.09.30
# => 83LX3pFwXQZeBBx/BbsHa
	ConvertToRepository 83LX3pFwXQZeBBx/BbsHa
# => dpi.inpe.br/banon/2004/02.16.09.30
	
	ConvertFromRepository sid.inpe.br/mtc-m13@80/2006/07.11.14.49
# => 6qtX3pFwXQZGivnJSY/LHVLx
	ConvertToRepository 6qtX3pFwXQZGivnJSY/LHVLx
# => sid.inpe.br/mtc-m13@80/2006/07.11.14.49
	ConvertFromRepository sid.inpe.br/MTC-m13@80/2006/07.11.14.49
# => can't read "inverseDigitArray(M)": no such element in array

	ConvertFromRepository sid.inpe.br/eprint@1905/2006/01.17.17.44
# => 6qtX3pFwXQZQjxQKYCT/JNtNC
	ConvertToRepository 6qtX3pFwXQZQjxQKYCT/JNtNC
# => sid.inpe.br/eprint@1905/2006/01.17.17.44
	ConvertFromRepository sid.inpe.br/ePrint@1905/2006/01.17.17.44
# => can't read "inverseDigitArray(P)": no such element in array

	
	ConvertFromRepository iconet.com.br/banon/2008/05.16.17.13
	ConvertToRepository CBnmVX32PXQZeBBx/UaJFT
	ConvertFromRepository iconet.com.br/banon/2008/05.16.17.13 1
	ConvertToRepository MJ9PM2X5SNX3NV5GM6L/335L8GH 1
	
	ConvertFromRepository iconet.com.br/banon/2008/07.28.13.00
	ConvertToRepository CBnmVX32PXQZeBBx/UU4Di
	ConvertFromRepository iconet.com.br/banon/2008/07.28.13.00 1
	ConvertToRepository MJ9PM2X5SNX3NV5GM6L/33HFSHB 1
	
	ConvertFromRepository dpi.inpe.br/banon-pc2@1905/2005/11.23.18.14
#	ConvertToRepository 83LX3pFwXQZ52hzrGTdYCT/Jfxuj
	ConvertToRepository 83LX3pFwXQZ52hzrGTdYCT/JfyKf
	ConvertFromRepository dpi.inpe.br/banon-pc2@1905/2005/11.23.18.14 1
#	ConvertToRepository R8PXCPPEX3NVEFG8TE2RKY4JH/QLGLBP 1
	ConvertToRepository R8PXCPPEX3NVEFG8TE2RKY4JH/QLGRA5 1
	ConvertFromRepository dpi.inpe.br/banon-pc2@80/2008/06.17.21.05
	ConvertToRepository 83LX3pFwXQZ52hzrGTdY/UuqTA
	ConvertFromRepository dpi.inpe.br/banon-pc2@80/2008/06.17.21.05 1
	ConvertToRepository R8PXCPPEX3NVEFG8TE2RKY/33ASD85 1
	
	ConvertFromBinary 10000001010011000111000 0 CreateReadingDigitList
	ConvertToBinary banon 0 CreateReadingDigitList
	
	ConvertToCaseInsensitiveIdentifier 150.163.2.14 800 1995/09.01.10.50
# 3ERPFQRT3W/753HE
	ConvertFromCaseInsensitiveIdentifier 3ERPFQRT3W/753HE
# 150.163.2.14 800 1995/09.01.10.50
	ConvertToCaseSensitiveIdentifier 150.163.2.14 800 1995/09.01.10.50
# kLwpN6zZ/kfnE
	ConvertFromCaseSensitiveIdentifier kLwpN6zZ/kfnE
# 150.163.2.14 800 1995/09.01.10.50
	ConvertToCaseInsensitiveIdentifier 150.163.2.174 800 2008/07.28.13.00
# J8LNKAN8PW/33HFSHB
	ConvertFromCaseInsensitiveIdentifier J8LNKAN8PW/33HFSHB
# 150.163.2.174 800 2008/07.28.13.00
	ConvertToCaseSensitiveIdentifier 150.163.2.174 800 2008/07.28.13.00
# 5R47GkUkZ/UU4Di
	ConvertFromCaseSensitiveIdentifier 5R47GkUkZ/UU4Di
# 150.163.2.174 800 2008/07.28.13.00
	ConvertToCaseInsensitiveIdentifier 127.0.0.1 800 2008/07.28.13.00
# LK47B6W/33HFSHB
	ConvertFromCaseInsensitiveIdentifier LK47B6W/33HFSHB
# 127.0.0.1 800 2008/07.28.13.00
	ConvertToCaseInsensitiveIdentifier 127.0.0.1 800 2001/02.10.22.55
## LK47B6W/E6GTK8
# LK47B6W/E6H5HH
	ConvertFromCaseInsensitiveIdentifier LK47B6W/E6H5HH
# 127.0.0.1 800 2001/02.10.22.55
	ConvertToCaseSensitiveIdentifier  127.0.0.1 800 2001/02.10.22.55
## APM77Z/p8LKL
# APM77Z/p8N6G
	ConvertFromCaseSensitiveIdentifier APM77Z/p8N6G
# 127.0.0.1 800 2001/02.10.22.55
	ConvertToCaseInsensitiveIdentifier 150.163.2.174 19050 2005/12.07.19.19
## J8LNKAN8PWU5H/QNQAU8
## J8LNKAN8PWT2T/QNQFSH
# J8LNKAN8PWU5H/QNQFSH
#	ConvertFromCaseInsensitiveIdentifier J8LNKAN8PWT2T/QNQFSH
	ConvertFromCaseInsensitiveIdentifier J8LNKAN8PWU5H/QNQFSH	;# done by GJFB on 2010-07-31
# 150.163.2.174 19050 2005/12.07.19.19
	ConvertToCaseSensitiveIdentifier  150.163.2.174 19050 2005/12.07.19.19
## 5R47GkUkZ8Jq/JoFuw
## 5R47GkUkZ8tk/JoGKs
# 5R47GkUkZ8Jq/JoGKs
#	ConvertFromCaseSensitiveIdentifier 5R47GkUkZ8tk/JoGKs
	ConvertFromCaseSensitiveIdentifier 5R47GkUkZ8Jq/JoGKs	;# done by GJFB on 2010-07-31
# 150.163.2.174 19050 2005/12.07.19.19
	ConvertToCaseInsensitiveIdentifier 150.163.34.246 802 2010/08.24.16.36
# 8JMKD3MGPBW34M/385JERB
	ConvertFromCaseInsensitiveIdentifier 8JMKD3MGPBW34M/385JERB
# 150.163.34.246 802 2010/08.24.16.36
	ConvertToCaseSensitiveIdentifier 150.163.34.246 802 2010/08.24.16.36
# KUqcbtHDZh9/39friC
	ConvertFromCaseSensitiveIdentifier KUqcbtHDZh9/39friC
# 150.163.34.246 802 2010/08.24.16.36

# Conversion CaseInsensitive -> CaseSensitive
	eval ConvertToCaseSensitiveIdentifier [ConvertFromCaseInsensitiveIdentifier 8JMKD3MGPBW/TM6792]
# KUqcbtHDZ/PGQKK

	ConvertToCaseInsensitiveIdentifier 2001:db8:85a3::8a2e:370:7334 800 1995/09.01.10.50
# 5UTMTS6QTGBR4DEK58HSPAQ8X/753HE
	ConvertFromCaseInsensitiveIdentifier 5UTMTS6QTGBR4DEK58HSPAQ8X/753HE
# 2001:db8:85a3::8a2e:370:7334 800 1995/09.01.10.50	
	ConvertToCaseInsensitiveIdentifier ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff 800 1995/09.01.10.50
# 7A6EQ5LJDPH6BN7HPAS6JBQTBHLK6R62QTX/753HE
	ConvertFromCaseInsensitiveIdentifier 7A6EQ5LJDPH6BN7HPAS6JBQTBHLK6R62QTX/753HE
# ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff 800 1995/09.01.10.50
	ConvertToCaseSensitiveIdentifier 2001:db8:85a3::8a2e:370:7334 800 1995/09.01.10.50
# 7JnzwQMgtKdvJjrhq8CpY/kfnE
	ConvertFromCaseSensitiveIdentifier 7JnzwQMgtKdvJjrhq8CpY/kfnE
# 2001:db8:85a3::8a2e:370:7334 800 1995/09.01.10.50
	
	set homePath {C:/tmp}
	set id [ConvertToCaseInsensitiveIdentifier 150.163.2.14 800 1995/09.01.10.50]
	StoreService id dpi.inpe.br/banon/1995/09.01.10.50 identifier 1 1
	set homePath {C:/Gerald/URLib 2}
	set id [ConvertToCaseInsensitiveIdentifier 127.0.0.1 800 2008/07.28.13.00]
	StoreService id iconet.com.br/banon/2008/07.28.13.00 identifier 1 1
	set id [ConvertToCaseInsensitiveIdentifier 192.168.1.100 800 2008/05.16.17.13]
	StoreService id iconet.com.br/banon/2008/05.16.17.13 identifier 1 1
	set id [ConvertToCaseInsensitiveIdentifier 127.0.0.1 800 2001/02.10.22.55]
	StoreService id iconet.com.br/banon/2001/02.10.22.55 identifier 1 1
	set id [ConvertToCaseInsensitiveIdentifier 150.163.2.174 19050 2005/12.07.19.19]	;# done before 2010-07-31
	StoreService id dpi.inpe.br/banon-pc2@1905/2005/12.07.19.19 identifier 1 1
	set id [ConvertToCaseInsensitiveIdentifier 127.0.0.1 800 2008/12.10.12.11]
	StoreService id iconet.com.br/banon/2008/12.10.12.11 identifier 1 1
}

proc TestingConvertFromRepository {} {
	return [catch {ConvertFromRepository iconet.com.br/banon/1990/07.28.13.00}]
}

# ----------------------------------------------------------------------
# ListSubtraction
# used in FindNextUser
# ListSubtraction a b
# => a - b

proc ListSubtraction {list1Name list2Name} {
	upvar $list1Name list1
	upvar $list2Name list2
	set list {}
	foreach element $list1 {
		if {[lsearch -exact $list2 $element] < 0} {
			lappend list $element
		}
	}
	return $list
}

# ListSubtraction - end
# ----------------------------------------------------------------------
# GetArrayRange
# used in FindNextUser

proc GetArrayRange {arrayName} {
	upvar $arrayName array
	set list {}
	foreach index [array names array] {
		lappend list $array($index)
	}
	return $list
}

# GetArrayRange - end
# ----------------------------------------------------------------------
# FindMirrorRepositoryOfSubmissionFormRepository
# used in Script (script.tcl - Meta form) and CreateTclPage only

proc FindMirrorRepositoryOfSubmissionFormRepository {submissionFormRepository} {
	global serverAddressWithIP
	global loBiMiRep	;# set in Script or 

# metadataRep of the submission form (repository E)
	set metadataRep [Execute $serverAddressWithIP [list FindMetadataRep $submissionFormRepository]]
# puts --$metadataRep--
	SetFieldValue $serverAddressWithIP $metadataRep-0 {childrepositories}	;# child repositories of E - they are mirror home page repositories A(s)
# puts --$childrepositories--
	set mirrorRepCandidateList {}
	foreach childRep $childrepositories {	;# child repositories of E - one or more of these repositories are A(s) - an A may content (or not), its own file mirroHomePage.html
		set childMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $childRep]]	;# metadata repository of one of these A(s)
#		SetFieldValue $serverAddressWithIP $childMetadataRep-0 {childrepositories contenttype}
#		if {[string compare {} $contenttype] == 0} {break}	;# childRep is a mirror home page repository (is not a Tcl Page like for reviewer assignment repository)
		SetFieldValue $serverAddressWithIP $childMetadataRep-0 {childrepositories targetfile}	;# child repositories and target file of one of these A(s)
if 0 {
# commented by GJFB on 2025-01-10 because the file mirrorHomePage.html may not exist to guarantee the access to the default mirrorHomePage.htm and the target file value of A may then be empty
		if [string equal {mirrorHomePage.html} $targetfile] {
# childRep is a mirror home page repository (A)
			lappend mirrorRepCandidateList [lindex $childrepositories 0]	;# take the first of the M(s)
		}
} else {
# added by GJFB on 2025-01-10 to use the fact that A should have at least one child repository whose content type value is Mirror
		foreach childRep $childrepositories {	;# child repositories of one the A(s) - theses children are Bibiographic Mirror (M)
			set childMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $childRep]]	;# metadata repository of one of these M(s)
			SetFieldValue $serverAddressWithIP $childMetadataRep-0 {contenttype}	;# content type of one of these M(s)
			if [string equal {Mirror} $contenttype] {
# childRep is a Bibliographic Mirror repository (M)
				lappend mirrorRepCandidateList [lindex $childrepositories 0]	;# take the first of the M(s)
			}
		}
}
	}
# mirrorRep
# if there are two mirror repository candidates, choose the one that is not loBiMiRep
# it this case loBiMiRep is just used for redirection purpose
	if {[llength $mirrorRepCandidateList] > 1} {
		foreach mirrorRepCandidate $mirrorRepCandidateList {
			if ![string equal $loBiMiRep $mirrorRepCandidate] {break}
		}
		set mirrorRep $mirrorRepCandidate
	} else {
		set mirrorRep $mirrorRepCandidateList
	}
	return $mirrorRep
}

# FindMirrorRepositoryOfSubmissionFormRepository - end
# ----------------------------------------------------------------------
# ReturnZipPath
# used by some cgi scripts
# used in Script (dpi.inpe.br/banon-pc@1905/2005/02.19.00.40) and Archive

proc ReturnZipPath {} {
	global env
	global tcl_platform
	global homePath

	source $homePath/col/$env(URLIB_SERVICE_REP)/doc/knownPathArray.tcl	;# needed by SetPath

	set zipPath [SetPath zip]
	if [string equal {} $zipPath] {
		error {ReturnZipPath: zip not found}
	}

	return $zipPath
}

# ReturnZipPath - end
# ----------------------------------------------------------------------
# MakeArchive
# used in Archive and Submit only
# makes or updates archive.zip containing the files in fileList and stores it in col/$currentRep/archive

proc MakeArchive {currentRep fileListName} {
	global homePath
	
	upvar $fileListName fileList
	
# zipFileAbsolutePath
	set zipFileAbsolutePath $homePath/col/$currentRep/archive/archive.zip
# pwd
	set pwd [pwd]
	if [file exists $homePath/col/$currentRep/archive/archive.zip] {
		set directoryMTime [DirectoryMTime $homePath/col/$currentRep/doc]
		set archiveZipMTime [file mtime $homePath/col/$currentRep/archive/archive.zip]
		if {$archiveZipMTime < $directoryMTime} {
# the archive must be updated
			file delete $homePath/col/$currentRep/archive/archive.zip
# ZIP
			cd $homePath/col/$currentRep/doc
			ZipManyFiles $zipFileAbsolutePath fileList
			cd $pwd
		}
	} else {
		file mkdir $homePath/col/$currentRep/archive
# ZIP
		cd $homePath/col/$currentRep/doc
		ZipManyFiles $zipFileAbsolutePath fileList
		cd $pwd
	}
}

# MakeArchive - end
# ---------------------------------------------------------------------
# ZipManyFiles
# needed in cgi scripts probably because of memory allocation limitation
# if zip doesn't produce any alert warning, then ZipManyFiles returns empty
# otherwise returns a HTML the warning message

# used in MakeArchive and dpi.inpe.br/banon-pc@1905/2005/02.19.00.40/doc/script.cgi only

proc ZipManyFiles {zipFileAbsolutePath fileListName} {
	global homePath
	
	upvar $fileListName fileList
	
# zipPath
	set zipPath [ReturnZipPath]
	
	set variableNameList {}
#	set shortFileListSize 100	;# didn't work with gabriela computer - too large
	set shortFileListSize 20	;# worked properly with gabriela computer
	for {set index 1} {$index <= $shortFileListSize} {incr index} {
		lappend variableNameList a$index
	}
	foreach $variableNameList $fileList {
# zip command works properly with shortFileList only and not long file list
		set shortFileList {}
		foreach variableName $variableNameList {
			set variableValue [set $variableName]
			if ![string equal {} $variableValue] {lappend shortFileList $variableValue}
		}
		catch {eval "exec \"$zipPath\" -r \"$zipFileAbsolutePath\" $shortFileList"} message
		set lineList {}
		foreach item [split $message \n] {
			if ![regexp {adding:} $item] {lappend lineList $item}
		}
		if ![string equal {} $lineList] {
# may contain an aborted warning (e.g., when the file list is too long (with Windows)) like: "zip warning: name not matched: Images2/.gle/AoLAxN"
#			puts <BR>[join [lrange $lineList 0 end] <BR>]<BR>
			set message2 [join $lineList \n]	;# may contain an aborted warning (e.g., when the file list is too long (with Windows))
			set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] MakeArchive (2): $message2\n"
#			puts $log
			Store log $homePath/@errorLog auto 0 a
			return <BR>[join $lineList <BR>]<BR>	;# error message for script.cgi
		}
	}
}

# ZipManyFiles - end
# ----------------------------------------------------------------------
# CreateOptionListForCopyright
# used in displayControl.tcl only
# returns the option list for the copyright field when sourced by CreateMirror

proc CreateOptionListForCopyright {currentCopyrightRepository} {
	global serverAddressWithIP	;# set in CreateMirror
	global codedPassword
	global homePath	;# set in CreateMirror
	global loCoInRep	;# set in CreateMirror
	
	if ![info exists codedPassword] {return}
# QUERY
	set query {contenttype, Copyright and not parentrepositories, *}	;# drop the repositories that have parents (they contain copyright translation)
	
# siteList
# uses @siteList.txt in >>> loCoInRep
	Load $homePath/col/$loCoInRep/doc/@siteList.txt fileContent
	set fileContent [string trim $fileContent]
	regsub -all "\n+" $fileContent "\n" fileContent
	set siteList {}
	lappend siteList $serverAddressWithIP	;# current site
	foreach siteRepIp [split $fileContent \n] {
		foreach {site2 loCoInRep2 ip2} $siteRepIp {break}
		foreach {serverName urlibPort} [ReturnCommunicationAddress $site2] {break}
		lappend siteList [list $ip2 $urlibPort]
	}
# puts $siteList
#	set metadataRepList [FindMetadataRepositories $query 0 [list $serverAddressWithIP] $codedPassword]	;# local site only
	set timeOut 300	;# 300 milliseconds - tested at banon-pc3
	set siteMetadataRepList [FindMetadataRepositories $query 0 $siteList $codedPassword no no 1 0 $timeOut]	;# {site rep-i} {site rep-i} ...

#	puts --$siteMetadataRepList--<BR>
#	set optionList {{}}
	set optionList {}
	set flag [expr ![string equal {} $currentCopyrightRepository]]	;# add the current copyright repository (if not empty)
	foreach siteMetadataRep $siteMetadataRepList {
		foreach {site rep-i} $siteMetadataRep {break}
#		SetFieldValue $site ${rep-i} {citationkey repository} 0 1	;# added by GJFB on 2013-02-24 in order to continue executing CreateOptionListForCopyright even the communication with a server doesn't start - commented by GJFB on 2023-12-20
		SetFieldValue $site ${rep-i} {shorttitle repository} 0 1	;# added by GJFB on 2013-02-24 in order to continue executing CreateOptionListForCopyright even the communication with a server doesn't start - added by GJFB on 2023-12-20 to display the shorttitle instead of the citationkey
# puts --$repository--
		if [string equal {} $repository] {
# conflicting server addresses (see SetFieldValue)
		} else {
#			lappend optionList [list $citationkey [list [list "$repository&nbsp;" $repository]]]	;# commented by GJFB on 2023-12-20
			lappend optionList [list $shorttitle [list [list "$repository&nbsp;" $repository]]]	;# added by GJFB on 2023-12-20 to display the shorttitle instead of the citationkey
		}
		if [string equal $repository $currentCopyrightRepository] {set flag 0}	;# don't add the current copyright repository
	}
# puts $optionList
#	set optionList [lsort -unique -index 0 $optionList]	;# commented by GJFB on 2023-12-20
	set optionList [lsort -unique -index 1 $optionList]	;# added by GJFB on 2023-12-20
	if $flag {
# useful when a server cannot be reached
		lappend optionList [list :: [list [list "$currentCopyrightRepository&nbsp;" $currentCopyrightRepository]]]
	}
	set optionList [concat {{}} $optionList]
#	puts $optionList<BR>
	return $optionList
}

# CreateOptionListForCopyright - end
# ----------------------------------------------------------------------
# ReturnAllowedIPList
# used in CreateMirror ComputeAccessRestrictionFlag and ComputeRedirectToMetadata
# example:
# ReturnAllowedIPList {deny from all and allow from 150.163.2.175 and allow from 150.163.8 150.163.4}
# => 150.163.2.175 150.163.4 150.163.8
# ReturnAllowedIPList {deny from all}
# => deny from all
# ReturnAllowedIPList {allow from all}
# => allow from all

proc ReturnAllowedIPList {readPermission} { 
   	if {1 == [regsub -all {deny} $readPermission x x] && ![string equal {deny from all} $readPermission]} {
# just one deny
# simplify - leave just the ip
if 0 {
		regsub {deny +from +all( +and +allow +from +)} $readPermission {\1} readPermission
		regsub -all { +and +allow +from +} $readPermission {  } readPermission
		set readPermission [string trim $readPermission]
} else {
		set readPermission [ExtractIPList $readPermission]	;# added by GJFB on 2012-10-03
}
	}
	return $readPermission
}
			
# ReturnAllowedIPList - end  
# ----------------------------------------------------------------------
# ExtractIPList
# used in ComputeReadPermissionFromSecondaryDate and ReturnAllowedIPList only

proc ExtractIPList {string} {
	regsub -all {[a-z]} $string {} string2
	return [lsort -unique [eval list $string2]]	;# drop unnecessary blanks
}

# ExtractIPList {deny from and allow from 150.163 and allow from 234}
# =>
# 150.163 234

# ExtractIPList - end
# ----------------------------------------------------------------------
# ComputeAccessRestrictionFlag
# used in CreateBriefEntry, CreateFullEntry, Get, Get- and xxDocContent.html
# returns 0 or 1; 1 for no access restrictions

proc ComputeAccessRestrictionFlag {readPermission remoteIp} {
	set readPermission [string trim $readPermission]	;# added by GJFBin 2014-08-21 - readPermission value may assume value like { allow from all}
	if [string equal {} $readPermission] {
		set noAccessRestrictionFlag 1	;# no access restrictions
	} else {
		set allowedIPList [ReturnAllowedIPList $readPermission]
		if [regexp {deny} $allowedIPList] {
			set noAccessRestrictionFlag 0
		} elseif {[string equal {allow from all} $allowedIPList]} {
			set noAccessRestrictionFlag 1	;# no access restrictions
		} else {
			set noAccessRestrictionFlag 0
			foreach ipPattern $allowedIPList {
				if [catch {regexp ^$ipPattern $remoteIp} flag] {continue}	;# ipPattern like *2009* cannot be compiled as a regular expression pattern
				if $flag {
					set noAccessRestrictionFlag 1	;# no access restrictions
					break
				}
			}
		}
	}
	return $noAccessRestrictionFlag
}

# ComputeAccessRestrictionFlag - end
# ----------------------------------------------------------------------
# MountQueryForDisplay

proc MountQueryForDisplay {query} {
#	if [regexp {^related:(.*?):(.*?):(.*?):(.*?):(.*?):(.*?):} $query m metadataRep-i language selectedFieldNameList numberOfCombinations importantWordList wordList] {
#		set query "related:$language:$importantWordList:"
#	}
	regsub -all {<} $query {\&lt;} queryForDisplay
	regsub -all {>} $queryForDisplay {\&gt;} queryForDisplay
	regsub -all {\$} $queryForDisplay {\\\\\$} queryForDisplay
	regsub -all {\[} $queryForDisplay {\\\\\[} queryForDisplay
	regsub -all {\]} $queryForDisplay {\\\\\]} queryForDisplay
	return $queryForDisplay
}

# MountQueryForDisplay
# ----------------------------------------------------------------------
# Max
# Find the max of two numbers

proc Max {x y} {
	return [expr [expr $x > $y]?$x:$y]
}

# Max - end
# ----------------------------------------------------------------------
# MaxOfAList
# Find the max of a list

proc MaxOfAList {xList {lowerBound -1000}} {
	set max $lowerBound
	foreach x $xList {
		set max [Max $max  $x]
	}
	return $max
}

# MaxOfAList - end
# ----------------------------------------------------------------------
# Min
# Find the min of two numbers

proc Min {x y} {
	return [expr [expr $x < $y]?$x:$y]
}

# Min - end
# ----------------------------------------------------------------------
# MinOfAList
# Find the min of a list

proc MinOfAList {xList {upperBound 1000}} {
	set min $upperBound
	foreach x $xList {
		set min [Min $min  $x]
	}
	return $min
}

# MinOfAList - end
# ----------------------------------------------------------------------
# Mean
# used with Correlation only

proc Mean {xList} {
	set sum 0.
	foreach x $xList {set sum [expr $sum + $x]}
	return [expr $sum / [llength $xList]]
}

# Mean - end
# ----------------------------------------------------------------------
# Variance
# used with GetMetadataRepositories only

proc Variance {xList} {
	set mean [Mean $xList]
	set sum 0.
	foreach x $xList {set sum [expr $sum + pow(($x - $mean), 2)]}
	
#	return [expr $sum / [llength $xList]]
	return [expr $sum / ([llength $xList] - 1)]
}

# Variance - end
# ----------------------------------------------------------------------
# Correlation
# Pearson product-moment correlation coefficient
# used with GetMetadataRepositories only

proc Correlation {xList yList} {
	set meanX [Mean $xList]
	set meanY [Mean $yList]
# puts $meanX
# puts $meanY
	set sum 0.
	set i 0
	foreach x $xList {
		set y [lindex $yList $i]
		set sum [expr $sum + ($x - $meanX) * ($y - $meanY)]
		incr i
	}
# puts [Variance $xList]
# puts [Variance $yList]
# puts [expr $sum / (sqrt([Variance $xList]) * sqrt([Variance $yList])) / ([llength $xList] - 1)]
	return [expr $sum / (sqrt([Variance $xList]) * sqrt([Variance $yList])) / ([llength $xList] - 1)]
}

# Correlation - end
# ----------------------------------------------------------------------
# ComputeSize
# Compute the size of the document in $rep

# not used (ComputeInfo is used instead) - GJFB on 2018-03-09
proc ComputeSize2 {rep {dir doc}} {
# runs with start and post
	global homePath
# puts {ComputeSize running}
	set size [expr int(ceil([DirectorySize $homePath/col/$rep/$dir] / 1024.))]	;# KiB
#	if {$size <= 1} {
#		set size "$size Kbyte"
#	} else {
#		set size "$size Kbytes"
#	}
	set size "$size KiB"
# puts $size
	return $size
}
# set homePath {C:/Users/Sony/URLib 2}
# puts [ComputeSize iconet.com.br/banon/2009/09.04.23.49]


# ComputeSize - end
# ----------------------------------------------------------------------
# DirectorySize
# Return the content size in bytes of a directory
# Return 0 if the directory doesn't exist or is empty
# is recursive
## used in UpdateRepMetadataRep and ComputeSize only
# used in UpdateRepMetadataRep only

if {[info tclversion] <= 8.3} {
	proc DirectorySize {dir {size 0}} {
# puts {DirectorySize running}
		set pwd [pwd]
		if ![file isdirectory $dir] {return 0}
		if [catch {cd $dir} err] {
			puts stderr $err
			return
		}
#		set fileList [glob -nocomplain .* *]
#		set fileList [lrange $fileList 2 end]	;# drop . ..
		set fileList [glob -nocomplain -- * .?*]
		set index [lsearch -exact $fileList {..}]
		set fileList [lreplace $fileList $index $index]
		foreach file $fileList {
			catch {set size [expr $size + [file size $file]]} ;# sometimes (UNIX) file size doesn't work (ex: file size .#ltab.doc)
# problem with a file named:
# ~$unzip.doc
# we get the message:
# user "$unzip.doc" doesn't exist
# when running [file isdirectory $file]
# with $file == ~$unzip.doc
#
# this problem occurs with 8.0 and not with 8.3
# for that reason we put a catch
#			if [file isdirectory $file]
			if [catch {file isdirectory $file} isdirectory] {
				continue	;# ignore such file name
			}
#
			if $isdirectory {
				set size [DirectorySize [file join $dir $file] $size]
			}
		}
		cd $pwd
		return $size
	}
} else {
	proc DirectorySize {dir {size 0}} {
# puts {DirectorySize running}
		set pwd [pwd]
		if ![file isdirectory $dir] {return 0}
		if [catch {cd $dir} err] {
			puts stderr $err
			return
		}
#		set fileList [glob -nocomplain *]	;# commented by GJFB on 2018-03-10
		set fileList [ComputeFileList]	;# added by GJFB on 2018-03-10 - to capture the hidden files of Linux as well
		if [string equal {utf-8} [encoding system]] {
# try iso8859-1 - solves the accent problem in gprb0705, col/urlib.net/www/2012/01.31.12.33/doc contains a file which name (AvaliaçãoRadiograficaSilhuetaCardiacaYorkshireTerrier.pdf) was iso coded - added by GJFB on 2015-01-09
			set fileList2 {}
			foreach file $fileList {
				if [file exists $file] {lappend fileList2 $file}
			}
			encoding system iso8859-1
#			set fileList [glob -nocomplain *]	;# commented by GJFB on 2018-03-10
			set fileList [ComputeFileList]	;# added by GJFB on 2018-03-10 - to capture the hidden files of Linux as well
			set fileList3 {}
			foreach file $fileList {
				if [file exists $file] {lappend fileList3 $file}
			}
if 0 {
# commented by GJFB on 2021-01-17 - doesn't work in plutao, col/dpi.inpe.br/plutao/2012/11.28.17.36/doc contains a file which exists with different names (polizel_caracterização.pdf polizel_caracterização.pdf) in both encoding systems
			set fileList [concat $fileList2 $fileList3]
			encoding system utf-8
			set fileList [lsort -unique $fileList]
} else {
# added by GJFB on 2021-01-17
			encoding system utf-8
# puts "fileList2 == $fileList2"
# puts "fileList3 == $fileList3"
# => fileList2 == testê.txt
# => fileList3 == testê.txt
#			if {[llength $fileList2] > [llength $fileList3]} #	;# commented by GJFB on 2023-10-26 - 'file size testê.txt' below works with patchlevel 8.5.7 (m16) but not with patchlevel 8.6.10 (plutao) - in the example, testê.txt must be used instead of testê.txt
			if {[llength $fileList2] >= [llength $fileList3]} {	;# added by GJFB on 2023-10-26 - when the length are the same fileList2 must be used instead of fileList3 to solve the above problem
				set fileList $fileList2
			} else {
				set fileList $fileList3
# => polizel_caracterização.pdf
			}
}
		} 
		foreach file $fileList {
# puts $file
			catch {set size [expr $size + [file size $file]]} message	;# sometimes (UNIX) file size doesn't work (ex: file size .#ltab.doc)
# puts $message
# problem with a file named:
# ~$unzip.doc
# we get the message:
# user "$unzip.doc" doesn't exist
# when running [file isdirectory $file]
# with $file == ~$unzip.doc
#
# this problem occurs with 8.0 and not with 8.3
# for that reason we put a catch
#			if [file isdirectory $file]
			if [catch {file isdirectory $file} isdirectory] {
				continue	;# ignore such file name
			}
#
			if $isdirectory {
				set size [DirectorySize [file join $dir $file] $size]
			}
		}
		cd $pwd
		return $size
	}
}
		
# puts "[expr [DirectorySize c:/usuario/gerald/URLib] / 1024] Kbytes"
# puts "[expr [DirectorySize cgi] / 1024] Kbytes"
# puts [DirectorySize xxx]
# puts [DirectorySize c:/usuario/gerald/URLib/col/iconet.com.br/banon/2001/09.29.12.08/doc]
# puts [DirectorySize {C:\Users\Sony\URLib 2\col\iconet.com.br\banon\2009\09.04.23.49\doc}]

# DirectorySize - end
# ----------------------------------------------------------------------
# ComputeFileList
# created by GJFB on 2018-03-10 - similar code in DirectoryContent to capture in Linux, file name like .htaccess
# used in DirectorySize and DirectoryInfo
# modified by GJFB on 2018-12-04 to exclude the file name .htaccess and .htaccess2

proc ComputeFileList {} {
	global tcl_platform
	
	set fileList [glob -nocomplain *]	;# in Windows, file name beginning with . are captured by glob, but not in Linux
	if {$tcl_platform(platform) == "unix"} {
		set fileList2 [glob -nocomplain .?*]
		set index [lsearch -exact $fileList2 ..]
		set fileList2 [lreplace $fileList2 $index $index]
		set fileList [concat $fileList $fileList2]
	}
if 1 {
# added by GJFB on 2018-12-04 - useful to allow detecting absence of full text from the size or numberoffiles value (utilizado nas páginas para autoarquivamento)
	set index [lsearch -exact $fileList {.htaccess}]
	set fileList [lreplace $fileList $index $index]	;# drop .htaccess
	set index [lsearch -exact $fileList {.htaccess2}]
	set fileList [lreplace $fileList $index $index]	;# drop .htaccess2
}
	return $fileList
}

# ComputeFileList - end
# ----------------------------------------------------------------------
# GetAgreement
# used in Submit and xxSubmit.html only

proc GetAgreement {} {
	upvar homePath homePath
	upvar submissionFormLanguageRep submissionFormLanguageRep
	upvar submissionFormLanguage submissionFormLanguage
	upvar referenceType2 referenceType2
	upvar languageRep2 languageRep2
	upvar language language
	upvar referenceType referenceType
	upvar submitFooterArray submitFooterArray
	
	set fileContent [Include $homePath/col/$submissionFormLanguageRep/doc/include/${submissionFormLanguage}${referenceType2}SubmitFooter.html]
	if [string equal {} $fileContent] {
		set fileContent [Include $homePath/col/$languageRep2/doc/include/${language}${referenceType2}SubmitFooter.html]
		if [string equal {} $fileContent] {
			set fileContent $submitFooterArray($referenceType)
		}
	}
	return $fileContent
}
	
# GetAgreement - end
# ----------------------------------------------------------------------
# TraceProcedure

proc TraceProcedure {{xxx {}} {clearCurrentTimeFlag 0}} {
# runs with post and cgi script
	global homePath
	global URLibServiceRepository
	
	upvar enableTrace enableTrace
	
	if [string equal 1 $enableTrace] {	
		if [string equal {} $xxx] {
			if $clearCurrentTimeFlag {file delete $homePath/col/$URLibServiceRepository/auxdoc/@currentTime}	;# add by GJFB on 2020-08-13
# compute executing time interval
			if {[info tclversion] > 8.4} {set currentTime [clock microseconds]} else {set currentTime [clock seconds]}
			if [file exists $homePath/col/$URLibServiceRepository/auxdoc/@currentTime] {
				Load $homePath/col/$URLibServiceRepository/auxdoc/@currentTime previousTime
				set xxx "executing time interval = [expr $currentTime - $previousTime]"
#				Store currentTime $homePath/col/$URLibServiceRepository/auxdoc/@currentTime	;# commented by GJFB on 2020-08-13
			}
			Store currentTime $homePath/col/$URLibServiceRepository/auxdoc/@currentTime	;# add by GJFB on 2020-08-13
 		}
#		puts $xxx
	 	Store xxx $homePath/col/$URLibServiceRepository/auxdoc/@procedureTrace auto 0 a
	}
}

# TraceProcedure - end
# ----------------------------------------------------------------------
# returnFileSize
# used in GetSiteInformation and others
# forceMega value is 0 or 1
# 1 means to force display in mega byte unit

proc returnFileSize {absoluteFilePath {forceMegaByte 0}} {
	set size [file size $absoluteFilePath]
	if {$size < 1048576 && !$forceMegaByte} {
		if {$size <= 51 && !$forceMegaByte} {	;# added by GJFB on 2018-03-09 - 51 B == 0.0 KiB and 52 B == 0.1 KiB
			set size2 [format "%.0f&nbsp;B&nbsp;&nbsp;&ensp;&ensp;&ensp;" $size]	;# B
		} else {
			set size2 [format "%.1f&nbsp;KiB&thinsp;" [expr $size / 1024.]]	;# KiB
		}
	} else {
		set size2 [format "%.1f&nbsp;MiB" [expr $size / 1048576.]]	;# MiB
	}
	return $size2
}

# returnFileSize - end
# ----------------------------------------------------------------------
# CheckMetadataSimilarity
# checking is done along the sites define in the default site list (see @siteList.txt in the current mirror repository defined globally in currentRep)
# used in Submit and Script (administrator page)
# creatorType values are {}, author, editor, translator, ...
# used in cgi scripts only
# the label value is used in the similarity search expression
# searchHiddenFlag value is 0 or 1, 1 (default) means searching hidden metadata as well

proc CheckMetadataSimilarity {
	referenceType creatorType creator title {citationKey2 {}} {label {}} 
	{userName {}} {searchHiddenFlag 1}
} {
	global searchResultList
#	global col
	global homePath
	global env
#	global currentRep
	global citationKey	;# used in Submit within subst (see: a repository already exists)
	global homePath
	global loCoInRep
 
	array set environment [array get env]	;# used in MultipleSubmit

if 0 {
 puts {Content-Type: text/html}
 puts {}
 puts [CallTrace]
}

	set citationKeyRepository dpi.inpe.br/banon/1999/07.11.21.09
#	if {[string equal {} $citationKey2] && \
	![string equal {} $creator] && \
	![string equal {} $title]} #	;# commented by GJFB on 2020-07-14
	
	if {[string equal {} $citationKey2] && \
	![string equal {} $title]} {	;# added by GJFB on 2020-07-14 to check similarity even in case of absence of creators (ex: absence of reporters)
		source $homePath/col/$citationKeyRepository/doc/createKey.tcl
#		set authorList {}
#		ProcessAuthorField authorList {} $creator
#		foreach field $authorList {
#			lappend authorList2 [join $field]
#		}
#		set citationKey [${citationKeyRepository}::CreateKey $authorList2 * $title $env(COMMON_WORDS)]
		set citationKey [${citationKeyRepository}::CreateKey $creator * $title $env(COMMON_WORDS)]
#		set author [join [KeepInitials [split $creator \n]]]
#		set searchExpression "referencetype, $referenceType and $creatorType, $author and title, $title and index, 0"
#		set searchExpression "referencetype, $referenceType and citationkey, $citationKey and index, 0"
		set searchExpression "referencetype, $referenceType or referencetype, Electronic and citationkey, $citationKey and index, 0"
	} elseif {![string equal {} $citationKey2]} {
		if [string equal {} $label] {
#			set searchExpression "referencetype, $referenceType and citationkey, $citationKey2 and index, 0"
			set searchExpression "referencetype, $referenceType or referencetype, Electronic and citationkey, $citationKey2 and index, 0"
		} else {
			if [regexp {^(scopus|isi)} $label] {
# scopus or isi
				set citationKey [lindex $label end]
				set searchExpression "referencetype, $referenceType or referencetype, Electronic and label, $citationKey and index, 0"
			} else {
# ISIS 2005
				set searchExpression "referencetype, $referenceType or referencetype, Electronic and citationkey, $citationKey2 and label, $label and index, 0"
			}
		}
	}
	if ![string equal {} $userName] {
		set searchExpression "$searchExpression and username, $userName"
	}

if 0 {
 puts {Content-Type: text/html}
 puts {}
 puts $searchExpression
}

	if [info exists searchExpression] {
		if $searchHiddenFlag {
# codedPassword
			Load $homePath/col/$loCoInRep/auxdoc/xxx data binary
			set data [UnShift $data]
			set codedPassword [lindex $data end]
#			set query [list list GetMetadataRepositories $currentRep 1 $searchExpression yes yes 0 {} repArray $codedPassword]	;# commented by GJFB on 2013-12-10 - the first argument of GetMetadataRepositories is for future use
			set query [list list GetMetadataRepositories {} 1 $searchExpression yes yes 0 {} repArray $codedPassword]	;# added by GJFB on 2013-12-10 - hidden metadata are searched
		} else {
			set query [list list GetMetadataRepositories {} 1 $searchExpression yes yes 0]	;# added by GJFB on 2014-06-11 - hidden metadata are not searched
		}
# MULTIPLE SUBMIT
		set searchResultList {}
# puts [list MultipleSubmit {} $query searchResultList 0]
# set xxx [list MultipleSubmit {} $query searchResultList 0] 
# Store xxx C:/Users/gerald.banon/tmp/bbb auto 0 a
		MultipleSubmit {} $query searchResultList 0	;# search based on @siteList.txt of the current mirror defined globally in currentRep
# puts <BR>
# puts --$searchResultList--
# exit
		return $searchResultList
	} else {
		return {}
	}
}

# CheckMetadataSimilarity - end
# ----------------------------------------------------------------------
## ReturnDocumentInformation
# ReturnFieldValueList
# used in CreateTclPage
# used to set document information in a pdf file created from a LaTeX file
# example of fieldNameList:
# title author keywords identifier secondarytype
# used in:
# iconet.com.br/banon/2009/08.16.19.35
# iconet.com.br/banon/2010/02.13.15.02
# dpi.inpe.br/banon-pc3@80/2009/11.10.13.03

proc ReturnFieldValueList {rep fieldNameList serverAddressWithIP {codedPassword {}}} {
	set query "repository, $rep"
	set searchResult [FindMetadataRepositories $query 0 [list $serverAddressWithIP] $codedPassword yes]	;# case is no
	SetFieldValue $serverAddressWithIP $searchResult $fieldNameList
	foreach fieldName $fieldNameList {lappend fieldValueList [set $fieldName]}
	return $fieldValueList
}

# ReturnFieldValueList - end

# ----------------------------------------------------------------------
# CreateVerdanaArray
# used in CreateDirectoryContentList

proc CreateVerdanaArray {} {
	set verdanaArray(4.7) {[il]}
	set verdanaArray(5.8) {[fj]}
	set verdanaArray(6.9) {[rtI]}
	set verdanaArray(8.7) {[cszJ-]}
	set verdanaArray(12.4) {[abdeghknopquvxy]}
	set verdanaArray(12.8) {[ ABCEFKLPRSTVXYZ0123456789]}
	set verdanaArray(13.1) {[DGHNOQU]}
	set verdanaArray(13.6) {[wM]}
	set verdanaArray(16.1) {[mW_@]}
	set verdanaArray(30) {[/]}
	return [array get verdanaArray]
}

# CreateVerdanaArray - end
# ----------------------------------------------------------------------
# CreateDirectoryContentList
# returns a list of HTML lines containing 3 columns: file name, modification time and size
# as well as the number of hidden files (j)
# each line corresponds to a file in the directory dir
# used in CreateFullEntry and in DisplayDocContent (see xxDocContent.html) only
# dir is the absolute path to doc, source, agreement or doc/tmp (see iconet.com.br/banon/2007/01.01.16.00 for doc/tmp)
# noAccessRestrictionFlag value is 0 or 1 (1 is default} - set in xxDocContent.html - added by GJFB on 2025-05-01 to control the download and SLA buttons

# proc CreateDirectoryContentList {currentRep dir {convertToUTF8 0} {targetFile {}}} #
proc CreateDirectoryContentList {
	currentRep dir {targetFile {}} {download download} {titleForDownload {}}
	{SLA SLA} {titleForSLA {}} {titleForWrongFilePath {}} {titleForThisInformationItemHomePage {}} {width 54}
	{noAccessRestrictionFlag 1}
} {
	global homePath
	global localSite
	global env
# puts OK	
	set encodingSystem [encoding system]	;# to preserve the current encoding system
	if [info exists env(ENCODING_SYSTEM)] {
		set postEncodingSystem $env(ENCODING_SYSTEM)
	} else {
		set postEncodingSystem [encoding system]
	}
# puts $encodingSystem
# puts $postEncodingSystem
# => iso8859-1 utf-8 (m09)
	encoding system $postEncodingSystem	;# use the encoding system of post	
	set fileList {}
#	DirectoryContent fileList $dir $dir 650	;# the result depends on the encoding system
#	DirectoryContent fileList $dir $dir 2500	;# the result depends on the encoding system - added by GJFB on 2014-08-06 - needed for GPRB thesis
	DirectoryContent fileList $dir $dir	;# the glob result depends on the encoding system - added by GJFB on 2021-01-10 - no bound
	encoding system $encodingSystem	;# to preserve the current encoding system
	
#	set folder [file tail $dir]	;# doc, source or agreement
	regexp "$homePath/col/$currentRep/(.*)" $dir m folder	;# doc, source, agreement or doc/tmp (see iconet.com.br/banon/2007/01.01.16.00 for doc/tmp)

# Compute maxFileNameSize
	array set verdanaArray [CreateVerdanaArray]

#	set a 0.72
#	set a 0.9
	set a 0.86
#	set b 0	
	set b 2.4	
	set maxFileNameSize 0
	foreach file $fileList {
		set fileNumberOfLetters [string length $file]
		set numberOfLetters 0
		set fileNameSize 0
		foreach name [array names verdanaArray] {
			set n [regexp -all $verdanaArray($name) $file]
			incr numberOfLetters $n
			set fileNameSize [expr $fileNameSize + ($name - $b)*$n]
		}
		set fileNameSize [expr $fileNameSize + (10 - $b)*($fileNumberOfLetters - $numberOfLetters)]
		if [string equal $targetFile $file] {
# bold is larger
			set fileNameSize [expr 1.11*$fileNameSize]
		}
		if {$fileNameSize > $maxFileNameSize} {
			set maxFileNameSize $fileNameSize
		}
	}
	set maxFileNameSize [expr 44 + $a*$maxFileNameSize]	;# 44 is for ' :: '
	if {$maxFileNameSize < 260} {set maxFileNameSize 260}
# Compute maxFileNameSize - end
		
	set tdWidth [expr $width + $maxFileNameSize]
	set i 0	;# included
	set j 0	;# excluded
	set lineList {}
	foreach file [lsort -dictionary $fileList] {
#		if [regexp -nocase {\.php$} $file] #	;# commented by GJFB on 2019-12-05
#		if [regexp -nocase {\.php$|^\.htaccess2?$} $file] #	;# added by GJFB on 2019-12-05 to avoid the Apache message Forbidden that may contain (for old version of Apache) a line like; Apache/2.2.15 (CentOS) DAV/2 PHP/5.3.3 Server at plutao.sid.inpe.br Port 80 - commented by GJFB on 2024-05-09
		if [regexp -nocase {^\.htaccess2?$} $file] {	;# added by GJFB on 2024-05-09 - target file like index.php should be visible to allow its remote editing
			incr j
		} else {
			set cellBackgroundColor [lindex {#EEEEEE #E3E3E3} [expr $i % 2]]
# backslash below are needed to avoid newline, because lineList is sent via socket upon request in MirrorGet
			lappend lineList "\
				<TR BGCOLOR=$cellBackgroundColor>\
					<TD class=displayTD style=\"width: ${tdWidth}px\">\
					<!-- <TD class=displayTD style=\"white-space: nowrap\"> -->\
						[
							if {0 && [string equal {source} $folder]} {	;# forced to 0 by GJFB on 2025-05-01 - the source folder should now be treated as the doc folder 
								regsub -all -- {\$} $file {\$} file2
								set file2
							} else {
# doc, source and agreement - added by GJFB on 2025-05-01
								set convertToUTF8 [expr [string equal {utf-8} $postEncodingSystem] && ![file exists $homePath/col/$currentRep/$folder/$file]]	;#  solves the accent problem when image file names are coded differently (iso and utf) in the same directory (in consequence of a migration between different operating systems (iso and utf)) - added by GJFB on 2013-09-01 - with the new operating system of md-m09.sid.inpe.br, inputList was created (in UpdateRepMetadataRep) with utf-8 as given by $env(ENCODING_SYSTEM) and the current encoding system is iso8859-1 (because of the apache configuration: AddDefaultCharset ISO-8859-1)
#								if [string equal $targetFile $file] #	;# commented by by GJFB on 2025-05-01
								if {[string equal {doc} $folder] && [string equal $targetFile $file]} {	;# added by GJFB on 2025-05-01 - the source folder has no target file
#									set file2 "<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>$file</B></A>"
									if [string equal {doc} $folder] {	;# commented by by GJFB on 2025-05-01
#									if [regexp {doc|source} $folder] 	;# added by GJFB on 2025-05-01 - the source folder should now be treated as the doc folder
#										if [regexp {[^a-zA-Z0-9!@$¨&( )\-_=+´`{\[~^\]},.;]} [file tail $file]] #	;# commented by GJFB on 2025-05-01
										if [regexp {[^a-zA-Z0-9!@$¨&( )\-_=+´`{~^},.;]} [file tail $file]] {	;# added by GJFB on 2025-05-01 - discard '[' and ']'
# SLA - contains at least one character not listed above, for example ã or %
#											set file2 "<div style=\"float: left; text-align: center; width: ${width}px;\"><A HREF=\"http://$localSite/col/$currentRep/$folder/$file\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>[regsub -all {/} $file {</b>/<b>}]</B></A></span>"	;# commented by GJFB on 2020-08-04
#											set file2 "<div style=\"float: left; text-align: center; width: ${width}px;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>[regsub -all {/} $file {</b>/<b>}]</B></A></span>"	;# added by GJFB on 2020-08-04 - solved accent problem - commented by GJFB on 2021-01-20
#											set file2 "<span style=\"white-space: nowrap;\"><div style=\"float: left; text-align: center; width: ${width}px;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {</b>/<b>}]</B></A></span>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces
#											if {[regexp {(ibi-?|rep-?)/[^/]+(\.|W|Z)[^/]*/[^/]*} $file] || [regexp {doi/10\.[^/]*/[^/]*} $file] || [regexp {(goto-?|rep-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - Commented by GJFB on 2023-06-05
#											if {[regexp {ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {fullypersistenthref/} $file] || [regexp {(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2023-06-05 - commented by GJFB on 2025-06-10
#											if {[regexp {^ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {^(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-06-10 - commented by GJFB on 2025-09-13
											if [regexp {^goto-?/[^/]*/[^/]*/[^/]*/} $file] {	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-09-13
#												set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<font style=\"color: brown\" title=\"$titleForWrongFilePath\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</B></font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - commented by GJFB on 2025-05-01
												set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForSLA\">$SLA</A></div>&nbsp\;::&nbsp\;}:{}]<font style=\"color: brown\" title=\"$titleForWrongFilePath\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</B></font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - added by GJFB on 2025-05-01
											} else {
#												set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {</b>/<b>}]</B></A>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces - commented by GJFB on 2025-05-01
												set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForSLA\">$SLA</A></div>&nbsp\;::&nbsp\;}:{}]<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {</b>/<b>}]</B></A>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces - added by GJFB on 2025-05-01
											}
										} else {
#											if {[regexp {(ibi-?|rep-?)/[^/]+(\.|W|Z)[^/]*/[^/]*} $file] || [regexp {doi/10\.[^/]*/[^/]*} $file] || [regexp {(goto-?|rep-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - Commented by GJFB on 2023-06-05
#											if {[regexp {ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {fullypersistenthref/} $file] || [regexp {(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2023-06-05 - commented by GJFB on 2025-06-10
#											if {[regexp {^ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {^(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-06-10 - commented by GJFB on 2025-09-13
											if [regexp {^goto-?/[^/]*/[^/]*/[^/]*/} $file] {	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-09-13
#												set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp;::&nbsp;<font style=\"color: brown\" title=\"$titleForWrongFilePath\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</B></font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - commented by GJFB on 2025-05-01
												set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp\;::&nbsp\;}:{}]<font style=\"color: brown\" title=\"$titleForWrongFilePath\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</B></font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - added by GJFB on 2025-05-01
											} else {
#												set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp;::&nbsp;<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {</b>/<b>}]</B></A>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces - commented by GJFB on 2025-05-01
												set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp\;::&nbsp\;}:{}]<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {</b>/<b>}]</B></A>"	;# added by GJFB on 2025-05-01 to control the display of the download button
											}
										}
									} else {
										set file2 "<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>$file</B></A>"
									}
								} else {
#									if [string equal {doc} $folder] #	;# commented by by GJFB on 2025-05-01
									if [regexp {doc|source} $folder] {	;# added by GJFB on 2025-05-01 - the source folder should now be treated as the doc folder
## doc
# doc and source
#										if [regexp {[^a-zA-Z0-9!@$¨&( )\-_=+´`{\[~^\]},.;]} [file tail $file]] #	;# commented by GJFB on 2025-05-01
										if [regexp {[^a-zA-Z0-9!@$¨&( )\-_=+´`{~^},.;]} [file tail $file]] {	;# added by GJFB on 2025-05-01 - discard '[' and ']'
# SLA - contains at least one character not listed above, for example ã or %
#											set file2 "<div style=\"float: left; text-align: center; width: ${width}px;\"><A HREF=\"http://$localSite/col/$currentRep/$folder/$file\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">[regsub -all {/} $file {<b>/</b>}]</A></span>"	;# commented by GJFB on 2020-08-04
#											set file2 "<div style=\"float: left; text-align: center; width: ${width}px;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">[regsub -all {/} $file {<b>/</b>}]</A></span>"	;# added by GJFB on 2020-08-04 - solved accent problem - commented by GJFB on 2021-01-20
#											set file2 "<div style=\"float: left; text-align: center; width: ${width}px;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</A></span>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces
#											if {[regexp {(ibi-?|rep-?)/[^/]+(\.|W|Z)[^/]*/[^/]*} $file] || [regexp {doi/10\.[^/]*/[^/]*} $file] || [regexp {(goto-?|rep-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - Commented by GJFB on 2023-06-05
#											if {[regexp {ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {fullypersistenthref/} $file] || [regexp {(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2023-06-05 - commented by GJFB on 2025-06-10
#											if {[regexp {^ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {^(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-06-10 - commented by GJFB on 2025-09-13
											if [regexp {^goto-?/[^/]*/[^/]*/[^/]*/} $file] {	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-09-13
#												set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<font style=\"color: brown\" title=\"$titleForWrongFilePath\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - commented by GJFB on 2025-05-01
												set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" title=\"$titleForSLA\">$SLA</A></div>&nbsp\;::&nbsp\;}:{}]<font style=\"color: brown\" title=\"$titleForWrongFilePath\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - added by GJFB on 2025-05-01
											} else {
												set url [ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]
												set combiningDiacriticalMarkFlag 0; # added by GJFB on 2022-10-28 to detect Combining Diacritical Marks in file name like 'Ofi´cio TJSP 21102022 assinado.pdf' - see example in id QABCDSTQQW/47QM7KS (gjfb:1905)
												foreach character [split $file {}] {
													set unicode [scan $character %c]
													if {768 <= $unicode && $unicode <= 879} {set combiningDiacriticalMarkFlag 1; break}
												}
												if $combiningDiacriticalMarkFlag {
#													set file2 "<div style=\"float: left; text-align: center; width: ${width}px\">$SLA</div>&nbsp;::&nbsp;[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}] <!-- the file name contains a Combining Diacritical Mark -->"	;# added by GJFB on 2022-10-28 to avoid, otherwise, a 403 error when clicking the link below	;# commented by by GJFB on 2025-05-01
													set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\">$SLA</div>&nbsp\;::&nbsp\;}:{}][regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}] <!-- the file name contains a Combining Diacritical Mark -->"	;# added by GJFB on 2022-10-28 to avoid, otherwise, a 403 error when clicking the link below - added by GJFB on 2025-05-01
												} else {
#													set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"$url\" title=\"$titleForSLA\">$SLA</A></div>&nbsp;::&nbsp;<A HREF=\"$url\" TARGET=\"_blank\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</A>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces	;# commented by by GJFB on 2025-05-01
													set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"$url\" title=\"$titleForSLA\">$SLA</A></div>&nbsp\;::&nbsp\;}:{}]<A HREF=\"$url\" TARGET=\"_blank\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</A>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces - added by GJFB on 2025-05-01
												}
											}
										} else {
#											if {[regexp {(ibi-?|rep-?)/[^/]+(\.|W|Z)[^/]*/[^/]*} $file] || [regexp {doi/10\.[^/]*/[^/]*} $file] || [regexp {(goto-?|rep-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - Commented by GJFB on 2023-06-05
#											if {[regexp {ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {fullypersistenthref/} $file] || [regexp {(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2023-06-05 - commented by GJFB on 2025-06-10
#											if {[regexp {^ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $file] || [regexp {^(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $file]} #	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-06-10 - commented by GJFB on 2025-09-13
											if [regexp {^goto-?/[^/]*/[^/]*/[^/]*/} $file] {	;# see same coding in CreateAbsolutePath in utilitiesMirror.tcl to detect 409 error type - added by GJFB on 2025-09-13
#												set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp;::&nbsp;<font style=\"color: brown\" title=\"$titleForWrongFilePath\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - commented by GJFB on 2025-05-01
												set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp\;::&nbsp\;}:{}]<font style=\"color: brown\" title=\"$titleForWrongFilePath\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</font>"	;# added by GJFB on 2021-10-16 - the file path contains the names "ibi" or "fullypersistenthref" - added by GJFB on 2025-05-01
											} else {
												if {[string equal thisInformationItemHomePage.html $file] || [string equal [file dirname $targetFile]/thisInformationItemHomePage.html $file]} {
#													set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp;::&nbsp;<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><font style=\"color: brown\" title=\"$titleForThisInformationItemHomePage\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</font></A>"	;# added by GJFB on 2023-02-26 to solve a Google indexing requirement - commented by GJFB on 2025-05-01
													set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp\;::&nbsp\;}:{}]<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><font style=\"color: brown\" title=\"$titleForThisInformationItemHomePage\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</font></A>"	;# added by GJFB on 2023-02-26 to solve a Google indexing requirement - added by GJFB on 2025-05-01
												} else {
#													set file2 "<div style=\"float: left; text-align: center; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp;::&nbsp;<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</A>"	;# added by GJFB on 2021-01-20 to display the correct number of white spaces - commented by GJFB on 2025-05-01
													set file2 "[expr $noAccessRestrictionFlag?{<div style=\"float: left\; text-align: center\; width: ${width}px\"><A HREF=\"http://$localSite/attachment.cgi/$currentRep/$folder/$file\" title=\"$titleForDownload\">$download</A></div>&nbsp\;::&nbsp\;}:{}]<A style=\"white-space: nowrap\" HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">[regsub -all {/} [regsub -all { } $file {\&nbsp;}] {<b>/</b>}]</A>"	;# added by GJFB on 2025-05-01 to control the display of the download button - added by GJFB on 2025-05-01
												}
											}
										}
									} else {
										set file2 "<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">$file</A>"
									}
								}
							}
						]\
					</TD>\
					<TD class=displayRightTD style=\"width: [expr 6*17]px\">\
						[
							set properytList [ReturnFileProperties $homePath/col/$currentRep/$folder/$file {mtime size}]
							array set propertyArray $properytList
							set x [clock format $propertyArray(mtime) -format "%d/%m/%Y&nbsp;%H:%M"]
						]\
					</TD>\
					<TD class=displayRightTD style=\"width: [expr 6*9]px\">\
						[
							set x $propertyArray(size)
						]\
					</TD>\
				</TR>\
			"
			incr i
		}
	}
#	return [list $lineList $j]
#	return [list $lineList $i $j $maxLength]	;# added by GJFB on 2020-04-10 - $i used in xxDocContent.html only
	return [list $lineList $i $j $maxFileNameSize]	;# added by GJFB on 2020-04-10 - $i used in xxDocContent.html only
}

# CreateDirectoryContentList - end
# ----------------------------------------------------------------------
# ReturnFileProperties
# written by GJFB on 2015-01-14
# was written to solve the accent problem in file names (e.g., targetf *ão*)
# was tested with the repository below whose target file names have different encoding:
# sid.inpe.br/iris@1905/2005/07.28.06.42 (utf-8)
# sid.inpe.br/deise/1998/10.19.10.17 (iso8859-1)
# currently at mtc-m05.sid.inpe.br
# the propertyName are size, mtime and fullutf8
# used in CreateAbsolutePath, DirectoryMTime and CreateDirectoryContentList only

proc ReturnFileProperties {absoluteFilePath propertyNameList {forceMegaByte 0}} {
	
	set encodingSystem [encoding system]
	encoding system iso8859-1	;# added by GJFB on 2015-01-15 when ReturnFileProperties is run from non cgi-script (when DirectoryMTime is called by ComputeVersionState called by CreateBriefEntry)
# puts "absoluteFilePath = --$absoluteFilePath--"	;# this puts requires doing unpost/post
# => absoluteFilePath = --C:/Users/geral/URLib 2/col/urlib.net/www/2022/10.16.03.22/doc/Ofi´cio TJSP 21102022 assinado.pdf--
 	set absoluteFilePath1 [encoding convertto iso8859-1 $absoluteFilePath]	;# the value set in absoluteFilePath1 depends on the existence of the encoding command of the previous line - without this command/line the file name in absoluteFilePath1 may not be recognized (e.g., Publicação.pdf in sid.inpe.br/deise/1998/10.19.10.17) when ReturnFileProperties is called from CreateBriefEntry
# => absoluteFilePath1 = C:/Users/geral/URLib 2/col/urlib.net/www/2022/10.16.03.22/doc/Ofi?cio TJSP 21102022 assinado.pdf
	set absoluteFilePath8 [encoding convertto utf-8 $absoluteFilePath]
	
	set existenceFlag1 [file exists $absoluteFilePath1]	;# added by GJFB on 2022-10-22 to solve accent problem when calling CreateBriefEntry for urlib.net/www/2022/10.16.03.22
	set existenceFlag8 [file exists $absoluteFilePath8]

	foreach propertyName $propertyNameList {
		switch -exact $propertyName mtime {
			if $existenceFlag8 {
				set propertyValue [file mtime $absoluteFilePath8]
			} else {
				if $existenceFlag1 {
					set propertyValue [file mtime $absoluteFilePath1]
				} else {
					set propertyValue [file mtime $absoluteFilePath]	;# added by GJFB on 2022-10-22 to solve accent problem when calling CreateBriefEntry for urlib.net/www/2022/10.16.03.22
				}
			}
		} size {
			if $existenceFlag8 {
				set propertyValue [returnFileSize $absoluteFilePath8 $forceMegaByte]
			} else {
				if $existenceFlag1 {
#					set propertyValue $existenceFlag8	;# for testing and displaying existenceFlag8
					set propertyValue [returnFileSize $absoluteFilePath1 $forceMegaByte]
				} else {
					set propertyValue [returnFileSize $absoluteFilePath $forceMegaByte]
				}
			}
		} fullutf8 {
			set propertyValue $existenceFlag8
		}
		lappend propertyList $propertyName $propertyValue 
	}
	encoding system $encodingSystem
	return $propertyList
}

# ReturnFileProperties - end
# ----------------------------------------------------------------------
# StoreLog

# warningType value is notice, warning, alert or error
# procedureName is the name of the procedure that emits the message
# example: post (1)
# message is the message (without leading and trailing newlines) to be logged

proc StoreLog {warningType procedureName message} {
	global homePath
	
	set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] \[$warningType\] $procedureName:\n$message\n"
	Store log $homePath/@errorLog auto 0 a
	return $log
}

# StoreLog - end
# ----------------------------------------------------------------------
# ParsePathInfo
# added by GJFB on 2024-01-04
# used in ParseIBIURL only

proc ParsePathInfo {pathInfo} {
	
	set pathInfo [string trim $pathInfo]	;# added by GJFB on 2011-05-03 - some paths may contain trailing blanks that are interpreted further (see Get-) as /
# puts $pathInfo
# => /urlib.net/www/2021/03.06.22.00
#	if [regexp {^/(\w+/\w+)(\+?)/?(.*)} $pathInfo m opaqueIBI plus filePath] #
	if [regexp {^/(\w+/\w+)([+!:]?[^/]*)/?(.*)} $pathInfo m opaqueIBI commandString filePath] {
# puts $opaqueIBI
# possibly an opaqueIBI (ibip or ibin)
# puts [regexp {[^/01lIO]+X[^/01lIO]+Z[^/01lIOX]+[XY]?[^/01lIOX]*} $opaqueIBI]
		if [regexp {[^/01lIO]+X[^/01lIO]+Z[^/01lIOX]+[XY]?[^/01lIOX]*} $opaqueIBI] {
# =>>> (2nd) casesensitive identifier from domain name - ibin - not necessarely an identifier value (is an id value for records created before november 2008 and updated after that date)
# X Y Z are used as separators instead of . @ /
# ex.: ---X----X-Z--------Y--/-----
# ex: CBnmVX32PXQZeBBx/UU4Di (2nd) - iconet.com.br/banon/2008/07.28.13.00 (1st) - MJ9PM2X5SNX3NV5GM6L/33HFSHB (3rd) - LK47B6W/33HFSHB (4th)
if 1 {
			if [catch {ConvertToRepository $opaqueIBI} ibi] {error {syntax error 0}}
# http://gjfb:1905/rep/CBnmVX32PXQZeBBx/UU4Di works - this and some other similar URL were published in e-mail in 2008 but this format was abandoned and substituted by format 4th unless for records created before november 2008 and updated after that date
# id CBnmVX32PXQZeBBx/UU4Di not found - its id is LK47B6W/33HFSHB
# http://gjfb:1905/rep/LK47B6W/33HFSHB works well
# id LK47B6W/33HFSHB found

# http://urlib.net/rep/CBnmVX32PXQZeBBx/UqREN works
# id CBnmVX32PXQZeBBx/UqREN found
if 0 {
# added by GJFB on 2024-05-05 to solve the search of old repository name containing capital letters
			regsub {mtc} $ibi {MTC} ibi	;# mtc-m13 -> MTC-m13 - before 2008 some repositories were created case sensitive, ex: sid.inpe.br/MTC-m13@80/2006/07.11.14.49
			regsub {gemini} $ibi {Gemini} ibi	;# gemini -> Gemini - before 2008 some repositories were created case sensitive
			regsub {eprint} $ibi {e[pP]rint} ibi	;# eprint -> e[pP]rint - before 2008 some repositories were created case sensitive, ex: sid.inpe.br/ePrint@80/2007/06.29.13.52
}
} else {
# speeds resolution up but doesn't resolve, for historical reasons (see above), some (2nd) IBI format
			set ibi $opaqueIBI
}
# puts $ibi
#			set ibiType rep
		} elseif {[regexp -nocase {X} $opaqueIBI]} {
# >>> (3rd) caseinsensitive identifier from domain name - ibin - not an identifier value
# ex.: ---X----X--V---------Y---/------
# ex: MJ9PM2X5SNX3NV5GM6L/335L8GH
			if [catch {ConvertToRepository [string toupper $opaqueIBI] 1} ibi] {error {syntax error 1}}
# http://gjfb:1905/rep/MJ9PM2X5SNX3NV5GM6L/335L8GH works - this and some other similar URL were published in e-mail in 2008 but this format was abandoned and substituted by format 3rd
# id MJ9PM2X5SNX3NV5GM6L/335L8GH not found
#			set ibiType rep
		} elseif {[regexp {Z} $opaqueIBI]} {
# >>> (5th) casesensitive identifier from ip - experimental format for future use - not an identifier value
# ex.: ---------Z---/-------
# ex: 6RPa7umaZ/UaJFT
# may works only for the repositories created after 2010-07-31 (because of a change in ConvertFromCaseSensitiveIdentifier and ConvertToCaseInsensitiveIdentifier)
			set ipPortDateTime [ConvertFromCaseSensitiveIdentifier $opaqueIBI]
			set ibi [eval ConvertToCaseInsensitiveIdentifier $ipPortDateTime]
# http://urlib.net/6RPa7umaZ/UaJFT works
# id 6RPa7umaZ/UaJFT not found 
#			set ibiType ibip	;# ex: 6RPa7umaZ/UaJFT
		} elseif {[regexp -nocase {W} $opaqueIBI]} {
# =>>> (4th) caseinsensitive identifier from ip - ibip - identifier value 
# ex.: ---------W---/-------
# ex: NENDTJMTKW/335L8GH
			set ibi [string toupper $opaqueIBI]
#			set ibiType ibip	;# ex: NENDTJMTKW/335L8GH
		} else {
			error {syntax error 2}
		}
#	# elseif {[regexp {^/([^/]+/[^/]+/[^/]+/[^/+]+)(\+?)/?(.*)} $pathInfo m ibi plus filePath]} #
	} elseif {[regexp {^/([^/]+/[^/]+/[^/]+/[^/+!:]+)([+!:]?[^/]*)/?(.*)} $pathInfo m ibi commandString filePath]} {
# =>>> (1st) possibly a repository
# ex: iconet.com.br/banon/2008/05.16.17.13
# puts OK
		if ![regexp {^[^/]+/[^/]+/\d{4,}/\d{2}\.\d{2}\.\d{2}\.\d{2}($|\.\d{2}$|\.\d{2}\.\d{1,}$)} $ibi] {error {syntax error 3}}
#		set ibiType rep	;# ex: iconet.com.br/banon/2008/05.16.17.13
	} else {
		error {syntax error 4}
	}
	return [list $ibi $commandString $filePath]
	
}

#  ParsePathInfo - end
# ----------------------------------------------------------------------
# ParseIBIURL
# used in ReturnURLPropertyList, SelectAppropriateSimilar, Get and Get- only

if 0 {
	ParseIBIURL /83LX3pFwXQZeBBx/BbsHa {}
}

proc ParseIBIURL {pathInfo queryString} {
	global localSite
# puts OK
# puts [CallTrace]

	foreach {ibi commandString filePath} [ParsePathInfo $pathInfo] {break}
	
#	set verbList {}
	
# puts $plus
#	if [string equal {+} $plus] #
	if ![string equal {} $commandString] {
## +
#		lappend verbList GetAppropriateSimilar	;# GetAppropriateSimilar
		regsub -all {([+!:])} $commandString { \1} verbList
		set verbList [string trimleft $verbList]
		regsub -all {\+} $verbList {GetTranslation} verbList
		regsub -all {!} $verbList {GetLastEdition} verbList
		regsub -all {:} $verbList {GetMetadata} verbList
		
#		if [regsub {^\?} $queryString {} queryString2] #
## +??
#			lappend verbList GetMetadata	;# GetMetadata
#			set queryString $queryString2
#		#
		
	} else {
# puts "queryString = --$queryString--<BR>"
		set verbList {}
		if [regsub {^\?} $queryString {} queryString2] {
# ??
			lappend verbList GetMetadata	;# GetMetadata
#			if [regsub {^\+} $queryString2 {} queryString2] #
## ??+
#				lappend verbList GetAppropriateSimilar
#			#
			set queryString $queryString2
		}
# puts "queryString = --$queryString--<BR>"
	}

	foreach {name value} [split $queryString &=] {
		set cgi([DecodeURL $name]) [DecodeURL $value]
	}
# puts --[array get cgi]--

# part of the norm
	ConditionalSet requiredItemStatus cgi(ibiurl.requireditemstatus) {}
	ConditionalLappend verbList cgi(ibiurl.verblist)
	
# Ignore unknown verb
	set verbList2 {}
	foreach verb $verbList {
		if [string equal {GetMetadata} $verb] {lappend verbList2 $verb; continue}
		if [regexp {^GetMetadata\(.+\)$} $verb] {lappend verbList2 $verb; continue}
		if [string equal {GetLastEdition} $verb] {lappend verbList2 $verb; continue}
		if [string equal {GetTranslation} $verb] {lappend verbList2 $verb; continue}
		if [regexp {^GetTranslation\(.+\)$} $verb] {lappend verbList2 $verb; continue}
		if [string equal {GetFileList} $verb] {lappend verbList2 $verb; continue}
	}
	set verbList $verbList2
# Ignore unknown verb - end
	
# not part of the norm
	ConditionalSet backgroundLanguage cgi(ibiurl.backgroundlanguage) {}	;# ibiurl.backgroundlanguage is alias for languagebutton
	ConditionalSet cssFileURL cgi(ibiurl.cssfileurl) {}
	ConditionalSet metadataHeader cgi(ibiurl.metadataheader) {}	;# not in use
	ConditionalSet metadataFieldNameList cgi(ibiurl.metadatafieldnamelist) {}	
	ConditionalSet requiredSite cgi(ibiurl.requiredsite) {}
	regsub -all {\+} $requiredSite { } requiredSite	;# added by GJFB on 2020-02-03 - plutao.sid.inpe.br+800	-> plutao.sid.inpe.br 800
	
	ConditionalSet returnType cgi(ibiurl.returntype) {content}	;# added by GJFB on 2017-02-20 - used by the www.urlib.net resolver to get the url property list from the agency resolvers
	
	set reservedQueryFieldNames {
		ibiurl.requireditemstatus
		ibiurl.verblist
		
		ibiurl.backgroundlanguage
		ibiurl.cssfileurl
		ibiurl.metadataheader
		ibiurl.metadatafieldnamelist
		ibiurl.requiredsite
		
		ibiurl.returntype
	}
# ibiurl.returntype added by GJFB on 2017-02-20 - used by the www.urlib.net resolver to get the url property list from the agency resolvers or a warning message

#		ibiurl.trueibiflag
#		ibiurl.countoneclickflag
		
# puts [array names cgi]
	set queryList {}	;# added by GJFB on 2013-12-29
	foreach fieldName [array names cgi] {
		if {[lsearch $reservedQueryFieldNames $fieldName] != -1} {continue}
if 1 {
# added by GJFB on 2022-06-22 - corrects srcBody in Get { } -> {+}
# in Get, doing:
# puts parsedIBIURL
# =>
# parsedibiurl.querylist {requiredmirror dpi.inpe.br/banon/1999/06.19.17.00 ... searchinputvalue id+QABCDSTQQW/475F7Q8 searchsite gjfb:1905}
		regsub -all { } $cgi($fieldName) {+} fieldValue
} else {
# commented by GJFB on 2022-06-22
		set fieldValue $cgi($fieldName)
# otherwise:
# =>
# parsedibiurl.querylist {requiredmirror dpi.inpe.br/banon/1999/06.19.17.00 ... searchinputvalue {id QABCDSTQQW/475F7Q8} searchsite gjfb:1905}
}
		lappend queryList $fieldName $fieldValue	;# not a reserved query field name
	}
# puts $queryList
#	return [list parsedibiurl.ibitype $ibiType parsedibiurl.ibi $ibi parsedibiurl.filepath $filePath parsedibiurl.verblist $verbList parsedibiurl.similaritycriteria $similarityCriteria parsedibiurl.fieldnamelist $fieldNameList parsedibiurl.metadatafieldnamelist $metadataFieldNameList parsedibiurl.language $language parsedibiurl.metadataformat $metadataFormat parsedibiurl.metadataheader $metadataHeader parsedibiurl.cssfileurl $cssFileURL parsedibiurl.requiredsite $requiredSite parsedibiurl.requiredtimestamp $requiredTimeStamp parsedibiurl.requireditemstatus $requiredItemStatus parsedibiurl.querylist $queryList]
#	return [list parsedibiurl.ibi $ibi parsedibiurl.filepath $filePath parsedibiurl.verblist $verbList parsedibiurl.similaritycriteria $similarityCriteria parsedibiurl.fieldnamelist $fieldNameList parsedibiurl.metadatafieldnamelist $metadataFieldNameList parsedibiurl.backgroundlanguage $backgroundLanguage parsedibiurl.language $language parsedibiurl.metadataformat $metadataFormat parsedibiurl.metadataheader $metadataHeader parsedibiurl.cssfileurl $cssFileURL parsedibiurl.requiredsite $requiredSite parsedibiurl.requiredtimestamp $requiredTimeStamp parsedibiurl.requireditemstatus $requiredItemStatus parsedibiurl.querylist $queryList]
#	return [list parsedibiurl.ibi $ibi parsedibiurl.filepath $filePath parsedibiurl.verblist $verbList parsedibiurl.similaritycriteria $similarityCriteria parsedibiurl.metadatafieldnamelist $metadataFieldNameList parsedibiurl.backgroundlanguage $backgroundLanguage parsedibiurl.language $language parsedibiurl.metadataformat $metadataFormat parsedibiurl.metadataheader $metadataHeader parsedibiurl.cssfileurl $cssFileURL parsedibiurl.requiredsite $requiredSite parsedibiurl.requireditemstatus $requiredItemStatus parsedibiurl.querylist $queryList]
#	return [list parsedibiurl.ibi $ibi parsedibiurl.filepath $filePath parsedibiurl.verblist $verbList parsedibiurl.metadatafieldnamelist $metadataFieldNameList parsedibiurl.backgroundlanguage $backgroundLanguage parsedibiurl.language $language parsedibiurl.metadataformat $metadataFormat parsedibiurl.metadataheader $metadataHeader parsedibiurl.cssfileurl $cssFileURL parsedibiurl.requiredsite $requiredSite parsedibiurl.requireditemstatus $requiredItemStatus parsedibiurl.querylist $queryList]
#	return [list parsedibiurl.ibi $ibi parsedibiurl.filepath $filePath parsedibiurl.verblist $verbList parsedibiurl.metadatafieldnamelist $metadataFieldNameList parsedibiurl.backgroundlanguage $backgroundLanguage parsedibiurl.metadataheader $metadataHeader parsedibiurl.cssfileurl $cssFileURL parsedibiurl.requiredsite $requiredSite parsedibiurl.requireditemstatus $requiredItemStatus parsedibiurl.querylist $queryList]	;# commented by GJFB on 2017-02-20
	return [list parsedibiurl.ibi $ibi parsedibiurl.filepath $filePath parsedibiurl.verblist $verbList parsedibiurl.metadatafieldnamelist $metadataFieldNameList parsedibiurl.backgroundlanguage $backgroundLanguage parsedibiurl.metadataheader $metadataHeader parsedibiurl.cssfileurl $cssFileURL parsedibiurl.requiredsite $requiredSite parsedibiurl.requireditemstatus $requiredItemStatus parsedibiurl.querylist $queryList parsedibiurl.returntype $returnType]	;# added by GJFB on 2017-02-20
}

# ParseIBIURL - end
# ----------------------------------------------------------------------
# ResolveIBI

# URLib platform use:
# IBI URL syntax: http://serverAddress[/rep-|/rep]/ibi[+][/filePath][?queryString]
# general use:
# IBI URL syntax: http://serverAddress[/rep-]/ibi[+][/filePath][?queryString]

# examples of IBI URL:
# >>> (see other examples in col/urlib.net/www/2014/03.25.23.20/doc/anexo.txt)
# (the same examples are also in col/sid.inpe.br/mtc-m16c/2016/01.15.15.47/doc/anexo.txt)

if 0 {
# access to data or metadata
# data
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55
	http://gjfb:1905/rep-/iconet.com.br/banon/2001/02.10.22.55
	http://gjfb:1905/LK47B6W/E6H5HH
	http://gjfb:1905/urlib.net/www/2012/10.14.01.35
	http://gjfb:1905/urlib.net/www/2012/09.21.20.35?ibiurl.cssfileurl=http://urlib.net/iconet.com.br/banon/2003/05.31.10.45/mirrorStandard.css
# metadata
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55.05
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55.05?ibiurl.backgroundlanguage=en
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55.05?ibiurl.backgroundlanguage=fr
# => portuguese (browser setting)
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55.05?choice=short
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55.05?choice=fullBibINPE
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55.05:(BibINPE)
	http://gjfb:1905/dpi.inpe.br/banon/1999/06.19.17.00/mirrorget.cgi?ibiurl.backgroundlanguage=en&metadatarepository=iconet.com.br/banon/2002/02.02.20.42.32
		
# access to data and display menu
	http://gjfb:1905/rep/iconet.com.br/banon/2001/02.10.22.55
	http://gjfb:1905/rep/LK47B6W/E6H5HH
	http://gjfb:1905/rep/dpi.inpe.br/banon/1998/08.02.08.56
		
# access to data or metadata in the preferred language (set in the navigator)
# data
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55+
	http://gjfb:1905/LK47B6W/E6H5HH+
	http://gjfb:1905/dpi.inpe.br/banon/2000/02.20.10.44+
	http://gjfb:1905/dpi.inpe.br/banon/2000/02.20.10.08+
# metadata
	http://gjfb:1905/dpi.inpe.br/banon/2000/05.25.20.06+
	http://gjfb:1905/dpi.inpe.br/banon/1999/04.02.15.49+
	http://gjfb:1905/dpi.inpe.br/banon/1999/04.02.15.49+?choice=fullBibINPE
# =>  referencência não disponível no formato BibINPE
	http://gjfb:1905/dpi.inpe.br/banon/1999/04.02.15.49+:(BibINPE)
# =>  referencência não disponível no formato BibINPE
	http://gjfb:1905/dpi.inpe.br/banon/1999/04.02.15.49+:
	
# access to data or metadata content in a specific language
# data
	http://gjfb:1905/iconet.com.br/banon/2001/05.25.16.44+(en)
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55+(fr)
# => language warning

	http://gjfb:1905/LK47B6W/E6H5HH+(pt-BR)
	http://gjfb:1905/dpi.inpe.br/banon/2000/02.20.10.44+(en)
	http://gjfb:1905/dpi.inpe.br/banon/2000/02.20.10.44+(pt-BR)
	http://gjfb:1905/dpi.inpe.br/banon/2000/02.20.10.08+(pt-BR)
	
	http://urlib.net/sid.inpe.br/mtc-m19/2012/12.05.01.52	
	http://urlib.net/sid.inpe.br/mtc-m19/2012/12.04.22.56+	(uses the browser language preference)
	http://urlib.net/sid.inpe.br/mtc-m19/2012/12.04.22.56+(pt-BR)
	http://urlib.net/8JMKD3MGP7W/3D64LGS
	http://urlib.net/8JMKD3MGP7W/3D64LGS+(pt-BR)
	http://urlib.net/8JMKD3MGP7W/3D6463P+	(uses the browser language preference)
	http://urlib.net/8JMKD3MGP7W/3D6463P+(pt-BR)
# => portuguese

	http://urlib.net/sid.inpe.br/mtc-m19/2012/12.04.22.56
	http://urlib.net/sid.inpe.br/mtc-m19/2012/12.05.01.52+	(uses the browser language preference)
	http://urlib.net/sid.inpe.br/mtc-m19/2012/12.05.01.52+(en)	
	http://urlib.net/8JMKD3MGP7W/3D6463P
	http://urlib.net/8JMKD3MGP7W/3D6463P+(en)
	http://urlib.net/8JMKD3MGP7W/3D6463P?verblist=GetTranslation(en)
	http://urlib.net/8JMKD3MGP7W/3D64LGS+	(uses the browser language preference)
	http://urlib.net/8JMKD3MGP7W/3D64LGS+(en)
# => english

	http://urlib.net/8JMKD3MGP7W/3D6463P+(fr)
	http://urlib.net/8JMKD3MGP7W/3D6463P+(pt)
# => language warning
	
# metadata
	http://gjfb:1905/dpi.inpe.br/banon/2000/05.25.20.06
# => portuguese
	http://gjfb:1905/dpi.inpe.br/banon/2000/05.25.20.06+(en)
	http://gjfb:1905/dpi.inpe.br/banon/2000/05.25.20.06+(fr)
# => language warning
	
# access to a specific file
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56/post
	http://gjfb:1905/dpi.inpe.br/banon/1999/06.19.17.00/mirror.cgi?ibiurl.backgroundlanguage=en
	http://gjfb:1905/dpi.inpe.br/banon/1999/06.19.17.00/mirror.cgi/NewPassword
	http://gjfb:1905/83LX3pFwXQZeBBx/hvk3g/mirror.cgi/NewPassword?ibiurl.backgroundlanguage=en
	http://gjfb:1905/83LX3pFwXQZeBBx/hvk3g/mirrorsearch.cgi?query=ti+ibi&ibiurl.backgroundlanguage=en&continue=yes&ibiurl.cssfileurl=http://urlib.net/iconet.com.br/banon/2003/05.31.10.45/mirrorStandard.css
	http://gjfb:1905/CBnmVX32PXQZeBBx/RTewE
# => portuguese (browser setting)
	http://gjfb:1905/dpi.inpe.br/banon/1999/06.19.17.00/mirrorget.cgi?ibiurl.backgroundlanguage=en&metadatarepository=iconet.com.br/banon/2009/09.09.22.01.52&index=0&ibiurl.cssfileurl=http://urlib.net/iconet.com.br/banon/2003/05.31.10.45/mirrorStandard.css
	http://gjfb:1905/83LX3pFwXQZeBBx/hvk3g/mirrorget.cgi?ibiurl.backgroundlanguage=en&metadatarepository=iconet.com.br/banon/2009/09.09.22.01.52&index=0&ibiurl.cssfileurl=http://urlib.net/iconet.com.br/banon/2003/05.31.10.45/mirrorStandard.css
	
	http://urlib.net/sid.inpe.br/mtc-m19@80/2009/08.21.17.02.53/mirror.cgi/NewPassword
	http://urlib.net/8JMKD3MGP7W/35SP794/mirror.cgi/NewPassword		<- pb	
	
# access to a specific file in the preferred language
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55+/Readme.html
	
# access to a specific file in a specific language
	http://gjfb:1905/iconet.com.br/banon/2001/05.25.16.44+(en)/Readme.html
	
# access to the list of files
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetFileList
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetFileList&ibiurl.backgroundlanguage=en

# access to metadata
	http://gjfb:1905/iconet.com.br/banon/2001/05.25.16.44?ibiurl.verblist=GetMetadata
	http://gjfb:1905/iconet.com.br/banon/2001/05.25.16.44??
	http://gjfb:1905/iconet.com.br/banon/2001/05.25.16.44:
	http://gjfb:1905/iconet.com.br/banon/2001/05.25.16.44:(BibINPE)
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetTranslation+GetMetadata
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55+:
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55+:(BibINPE)
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56:
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56+:
# => returns the metadata always in english (first metadata language) (they are no document translations)
	http://gjfb:1905/J8LNKB5R7W/3AEMFL5:
	http://gjfb:1905/J8LNKB5R7W/3AEMFL5:?imageflag=0
	
# access to metadata in the preferred language
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56?ibiurl.verblist=GetMetadata+GetTranslation
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56?:+
# => returns the metadata based on languagepreference

# access to metadata in a specific language
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56:+(en)
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56:+(pt-BR)
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56:+(pt)
# => Metadados não encontrados
	http://gjfb:1905/dpi.inpe.br/banon/1998/08.02.08.56:+(fr)
# => Metadados não encontrados

# access to the last edition	
	http://gjfb:1905/rep/J8LNKAN8PW/U3RNES
	http://gjfb:1905/rep/J8LNKAN8PW/U3RNES?ibiurl.verblist=GetLastEdition
	http://gjfb:1905/J8LNKAN8PW/U3RNES!
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55!
# => the last edition is the current one
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55!:

	http://urlib.net/rep/8JMKD3MGP8W/35MMLL8
	http://urlib.net/rep/dpi.inpe.br/banon/1998/07.02.12.54!
	http://urlib.net/rep/8JMKD3MGP8W/35MMLL8!
	http://urlib.net/rep/8JMKD3MGP8W/35MMLL8!:
	http://urlib.net/8JMKD3MGP8W/35MMLL8:
		
# access to the last edition in a specific language	
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55!+
	http://gjfb:1905/J8LNKAN8PW/U3RNES!+	
		
# access in a specific language the last edition (in these examples, the result is the same)	
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetTranslation+GetLastEdition
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55+!
	http://gjfb:1905/J8LNKAN8PW/U3RNES+!	

# access a required site
	http://gjfb:1905.home/rep/urlib.net/www/2012/12.27.16.41?metadatarepository=urlib.net/www/2012/12.27.16.41.55&ibiurl.backgroundlanguage=pt-BR&ibiurl.requiredsite=gjfb:1905&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=gjfb:1905:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00
	http://gjfb:1905.home/rep/urlib.net/www/2012/12.27.16.41?metadatarepository=urlib.net/www/2012/12.27.16.41.55&ibiurl.backgroundlanguage=pt-BR&ibiurl.requiredsite=gjfb:1905+800&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=gjfb:1905:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00
	http://gjfb:1905/83LX3pFwXQZ52hzrGTdYCT/KbJr6?query=ref+conference&fieldlist=author+title
	http://gjfb:1905/83LX3pFwXQZ52hzrGTdYCT/KbJr6?query=ref+conference&fieldlist=author+title&ibiurl.requiredsite=mtc-m18.sid.inpe.br
	http://gjfb:1905/83LX3pFwXQZ52hzrGTdYCT/KbJr6?query=ref+conference&fieldlist=author+title&ibiurl.requiredsite=mtc-m18.sid.inpe.br+800
# non existing ibiurl.requiredsite:
# => same result

# nonexistent ibi
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.56
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.56+
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.56??
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.56:
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.56+:
	http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.56.05
	
	http://gjfb:1905/rep/iconet.com.br/banon/2001/02.10.22.56
	http://urlib.net/rep/8JMKD3MGP8W/35MMLL9
	
# removed (deleted) ibi
	http://gjfb:1905/J8LNKB5R7W/3E4NFH5
	http://gjfb:1905/urlib.net/www/2013/05.11.21.50
	http://urlib.net/rep/8JMKD3MGP7W/38LGJPL
}

# reserved query field names in queryString:
# used explicitly in ParseIBIURL (reservedQueryFieldNames)

# name											type		default						value example				value domain																																						description
# part of the norm (2)
## ibiurl.requireditemstatus					optional	{}							Original					Original {Secure Original} Copy or {}																																the required state of the item to be returned
# ibiurl.requireditemstatus						optional	{}							Original					Original Copy or {}																																the required state of the item to be returned
# ibiurl.verblist								optional	{}							list of one or more of the following verbs: GetTranslation GetLastEdition GetMetadata GetFileList	(order is relevant)																			used to select the appropriate returned data (GetFileList is not part of the url resolution system norm)

# not part of the norm (5)
# ibiurl.backgroundlanguage						optional	{}							pt-BR						en pt-BR  xx[-XX] ISO 639-1 language codes (http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes) and ISO 3166 country codes (https://www.iso.org/obp/ui/#search)	defines the required metadata language (just like languagebutton) - if its value is neither en nor pt-BR, then the browser setting is used - if omitted then language of the browser setting is used - if the browser setting is neither en nor pt-BR (nor pt), then english is used
# ibiurl.cssfileurl								optional	{}							http://urlib.net/iconet.com.br/banon/2003/05.31.10.45/mirrorStandard.css	RFC 1738 - URL																										url of the css file to be used when displaying html pages
# ibiurl.metadataheader							optional	{Content-Type: text/html}	"Content-Type: text/html"	"Content-Type: text/html" "Content-disposition: attachment; filename=metadata.txt"																					type of content - not in use - could be use to inform the browser about the kind of action to be done (useful for preparing download)
# ibiurl.metadatafieldnamelist					optional	{}							{identifier nexthigherunit shorttitle}																																							used to return the values of the specified metadata fields - used just in Get (to compute the return path) (metadatafieldnamelist is not part of the url resolution system norm)
# ibiurl.requiredsite							optional	{}							gjfb						http host address (gjfb - gjfb:1905) or server address (gjfb 800 - gjfb 19050}

# ibiurl.returntype								optional	{content}					urlpropertylist				content urlpropertylist																																				if return type is urlpropertylist then the resolver returns the url of the required content, otherwise it returns the content itself (a warning message - see Get and Get-) - added by GJFB on 2017-02-20 - used by the www.urlib.net resolver to get the url property list from the agency resolvers																					the site from which the document must returned

# metadataheader not used up to now
# ibiurl.metadatafieldnamelist is used with Get only

# ibiurl.verblist nonempty values
# part of the norm
# GetTranslation
# GetTranslation(en)							optional	{}							pt-BR						en pt-BR  xx[-XX] ISO 639-1 language codes (http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes) and ISO 3166 country codes (https://www.iso.org/obp/ui/#search)	defines the required item content language - useful to create a unique link for future use with new languages - if the language value is neither en nor pt-BR, then a warning message is displayed (identifier warning - similar not found) - if omitted then language of the browser setting is used - if the browser setting is neither en nor pt-BR (nor pt), the ibi of the ibi url is returned (no appropriate similar found)
# GetMetadata
# GetMetadata(BibINPE)							optional	Free						BibTeX						Free BibTeX BibINPE																																					format to be used when displaying the metadata (FREE is not a url resolution norm format)
# GetLastEdition

# not part of the norm
# GetFileList

# parsedIBIURL is a list for an array with 13 entries:
# parsedIBIURL may be returned using ParseIBIURL

#									name											type		default						value example										value domain					description
# part of the norm
#									parsedibiurl.filepath							optional	{}     						Readme.html											any well formed file names		used to access a specific file
#									parsedibiurl.ibi								required           						3ERPFQRT3W/39AFDTP									ABNT NBR 16066:2012				item identifier
#									parsedibiurl.requireditemstatus																																				value of ibiurl.requireditemstatus
#									parsedibiurl.verblist																																						value of ibiurl.verblist

# not part of the norm
#									parsedibiurl.backgroundlanguage																																				value of ibiurl.backgroundlanguage
#									parsedibiurl.cssfileurl																																						value of ibiurl.cssfileurl
#									parsedibiurl.querylist							optional	{}							requiredmirror dpi.inpe.br/banon/1999/06.19.17.00	any well formed query list		used to encapsulate unreserved query fields							
#									parsedibiurl.metadatafieldnamelist																																			value of ibiurl.metadatafieldnamelist
#									parsedibiurl.metadataheader																																					value of ibiurl.metadataheader
#									parsedibiurl.requiredsite																																					value of ibiurl.requiredsite

#									parsedibiurl.returntype							optional	{content}					urlpropertylist										content urlpropertylist			value of ibiurl.returntype - added by GJFB on 2017-02-20

# pathInfo
# queryString
# 				-> ParseIBIURL ->
#									parsedIBIURL
#									contextLanguage
# contextLanguage value is, for example, en or pt-BR
# contextLanguage is defined as selectedLanguageFromMirror in Get- or Get
# contextLanguage is the preferred langage AMONG the available translations of the firstLanguageRep
# for the current mirror (see its complete definition in FindPreferredLanguage in utilitiesStart.tcl)
# it depends on ibiurl.backgroundlanguage (languagebutton) and if omitted on the browser setting
# contextLanguage is used to display warning message in the available proper language (identifier not found and deleted identifier) from ResolveIBI
#                                   useURLibServerFlag
# useURLibServerFlag value is 0 (default) or 1, 1 means to find directly through the URLib server (used in FindSite2)
# useLocalServerOnlyFlag value is 0 or 1, 1 means to use the local server only (never use the URLib server) - used when the agency structure is enabled (takes precedence over useURLibServerFlag)

#													-> ResolveIBI ->
# 													criterionList
# criterionList is produced within ResolveIBI
# criterionList is a list for an array with the following entries:
#													name											default	value		value example					value domain							description
# client information for the Archive
#													clientinformation.ipaddress						{}					192.168.1.100					IPv4 or IPv6							used to decide what to display when there exist some access restrictions (if the IP is not allowed to access the item, then display just the metadata) - used in ComputeRedirectToMetadata only
#													clientinformation.citingitem					{}					urlib.net/www/2023/12.25.14.57	repository name							set in From and used in UpdateCitingItemList (called by CountOneClick) to turn persistent hyperlinks robust

# client information for the Resolver
#													clientinformation.languagepreference			{}					pt-br,en;q=0.5					pt-br,en;q=0.5 en pt-BR
#                                                   clientinformation.contextlanguage				{}					pt-BR							en pt-BR								used in GET only

#													name
# part of the norm
# parsed IBI URL for the Archive
#													parsedibiurl.filepath
#													parsedibiurl.ibi
#													parsedibiurl.verblist
# parsed IBI URL for the Resolver
#													parsedibiurl.requireditemstatus

# not part of the norm
#													parsedibiurl.backgroundlanguage
#													parsedibiurl.cssfileurl					
#													parsedibiurl.metadatafieldnamelist
#													parsedibiurl.metadataheader
#													parsedibiurl.querylist
#													parsedibiurl.requiredsite

# parsedibiurl.requiredsite has priority over parsedibiurl.requireditemstatus

# parsedibiurl.backgroundlanguage is used to display the file list, metadata field names and the get menu in the appropriate language

# examples of querystring:
# ibiurl.verblist=GetMetadata
# ibiurl.verblist=GetFileList

# some alias used in the ibi url query string:

# ?
# is alias for
# ibiurl.verblist=GetMetadata

# ibiurl.requiredsite=gjfb - useful to return the URL properties from a given site - used in the title of brief search result - useful when there are copies with the same ibi
# ibiurl.requiredsite=gjfb+800 - useful to return the URL properties from a given site - used in the title of brief search result - useful when there are copies with the same ibi
# ibiurl.requiredsite=gjfb:1905 - useful to return the URL properties from a given site - used in the title of brief search result - useful when there are copies with the same ibi
# ibiurl.requiredsite=gjfb+19050 - useful to return the URL properties from a given site - used in the title of brief search result - useful when there are copies with the same ibi

# ibiurl.cssfileurl=http://urlib.net/iconet.com.br/banon/2003/05.31.10.45/mirrorStandard.css

# displayWarningMessage value is 0 or 1
# 1 means to display the "identifier not found" message
# in this case contextLanguage must be a valid language (ex: en or pt-BR)

# callingProcedureName value is the name of the calling procedure (used for reverse engineering)
# example: Get

# returns empty or a list of url properties of the unique repository satisfying the criterion list
# the properties are:

# part of the norm
#							value example													value domain				description
## encodingsystem			cp1252															see [encoding names]		set in GetURLPropertyList and used in Get-
# archiveaddress			banon-pc.dpi.inpe.br:1905										subdomain [:port]			http address of the site (local collection) containing an IBI satisfying the criterion list - used for deleted identifier, used by Get, used by Get- to count one click, used by ReturnURLPropertyList to select the required site, used by FindURLPropertyList when detecting unfair sites and used by FindSite2
# contenttype				Data															Data Metadata {}			used by AcknowledgeArchive called be get- and get to decide to count one click ({} is for deleted IBI)
# ibi						rep iconet.com.br/banon/2001/02.10.22.55 ibip LK47B6W/E6H5HH	see ABNT NBR 16066:2012		set in GetURLPropertyList and used in Get
# ibi.archiveservice
# ibi.nextedition			rep iconet.com.br/banon/2001/02.10.22.55 ibip LK47B6W/E6H5HH                               	
# ibi.platformsoftware		rep dpi.inpe.br/banon/1998/08.02.08.56														used by FindURLPropertyList when detecting unfair sites and for debugging (finding the platform which doesn't conform with the norm)
## redirecttometadata		no																no, yes						if 1 and ibiurl.verblist is empty then redirect to the metadata
## site						banon-pc.dpi.inpe.br:1905										subdomain [:port]			http address of the site (local collection) containing an IBI satisfying the criterion list - used for deleted identifier, used by Get, used by Get- to count one click, used by ReturnURLPropertyList to select the required site, used by FindURLPropertyList when detecting unfair sites and used by FindSite2
# state						Original														Original Copy Deleted		used in Get, Get-, ReturnURLPropertyList2 and ResolveIBI
# timestamp					2014-04-11T19:49:22												YYYY-mm-ddTHH:MM:SS			used only to specify the date of the remotion of an ibi
# url																						RFC 1738 - URL             	
                                                                                                                       	
# not part of the norm                                                                                                 	
# metadatafieldlist																										list of field name and field value, the field names being defined in parsedibiurl.metadatafieldnamelist

# the list of url properties is a list for array produced by
# GetURLPropertyList and passed unchanged to FindURLPropertyList, ReturnURLPropertyList and ReturnURLPropertyList2

## must be used in cgi script only

# used ONLY in:
# cgi/cover.tcl: set urlPropertyList2 [ResolveIBI $parsedIBIURL $language 1]
# cgi/download.tcl: set urlPropertyList2 [ResolveIBI $parsedIBIURL $language 1]
# cgi/get-.tcl: set urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage {} 0 $agencyStructureFlag]
# cgi/get.tcl:
# set useURLibServerFlag 0	;# try locally first
# set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} $useURLibServerFlag $agencyStructureFlag]	;# added by GJFB on 2017-02-20
# set useURLibServerFlag 0	;# try locally first
# set urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage $currentProcedureName $useURLibServerFlag $agencyStructureFlag]	;# added by GJFB on 2017-02-20
# FindSite2: set urlPropertyList2 [ResolveIBI $parsedIBIURL $contextLanguage $displayWarningMessage {} $useURLibServerFlag]
# ResolveIBI2: return [ResolveIBI [array get ibiURLArray]]
# >>> from 2021-10-09 ResolveIBI is used just with useURLibServerFlag value 0

# extendedSearchFlag value is 0 (default) or 1 - 1 means to extend the search to Federated Archives
# extendedSearchFlag is set in BuildReturnPathArray (see get.tcl) and used in FindURLPropertyList2

proc ResolveIBI {
	parsedIBIURL {contextLanguage {}} {displayWarningMessage 0} {callingProcedureName {}}
	{useURLibServerFlag 0} {useLocalServerOnlyFlag 0} {extendedSearchFlag 0}
} {
# runs with post or a cgi-script
	global env
#	global cgi
	global homePath
	global localSite	;# used in "error $output"
#	global contentType	;# used in this procedure (see mirror/xxCover.tcl); set in SelectAppropriateSimilar
	global printFlag	;# set in Get and Get- only
	global depthLevel

	upvar languageRep1 languageRep1	;# used to display warning message only
	upvar languageRep2 languageRep2	;# used to display warning message only
	
# puts $printFlag	
if {[info exists printFlag] && $printFlag} {
	puts "ResolveIBI: input<BR>"
	puts [list parsedIBIURL $parsedIBIURL]<BR>
	puts [list contextLanguage $contextLanguage]<BR>
	puts [list displayWarningMessage $displayWarningMessage]<BR>
	puts [list callingProcedureName $callingProcedureName]<BR>
#	puts [list trueIBIFlag $countOneClickFlag]<BR>
#	puts [list countOneClickFlag $callingProcedureName]<BR>
	puts [list useURLibServerFlag $useURLibServerFlag]<BR>
#	puts [list currentPath $currentPath]<BR>
	puts <BR>
}

	set col ../../../../..

if $extendedSearchFlag {
# >>> to see the puts output go to the bottom of the source code page of the upper menu
#	puts [CallTrace]
}	
# puts [CallTrace]
# puts $parsedIBIURL
	array set ibiURLArray $parsedIBIURL
	
# part of the norm
	ConditionalSet filePath ibiURLArray(parsedibiurl.filepath) {}
	set ibi $ibiURLArray(parsedibiurl.ibi)
#	ConditionalSet language ibiURLArray(parsedibiurl.language) {}	;# if ibiURLArray(parsedibiurl.language) is not defined, then the browser preference will be used - see languagePreference below
#	ConditionalSet metadataFormat ibiURLArray(parsedibiurl.metadataformat) {}	;# Free
	ConditionalSet queryList ibiURLArray(parsedibiurl.querylist) {}
	ConditionalSet requiredItemStatus ibiURLArray(parsedibiurl.requireditemstatus) {}
#	ConditionalSet similarityCriteria ibiURLArray(parsedibiurl.similaritycriteria) {}	;# commented by GJFB on 2026-02-17 - no longer in use
	ConditionalSet verbList ibiURLArray(parsedibiurl.verblist) {}
	
	if ![string equal {} $filePath] {set criterionArray(parsedibiurl.filepath) $filePath}
	set criterionArray(parsedibiurl.ibi) $ibi
#	if ![string equal {} $language] {set criterionArray(parsedibiurl.language) $language}
#	if ![string equal {} $metadataFormat] {set criterionArray(parsedibiurl.metadataformat) $metadataFormat}
	if ![string equal {} $queryList] {set criterionArray(parsedibiurl.querylist) $queryList}
	if ![string equal {} $requiredItemStatus] {set criterionArray(parsedibiurl.requireditemstatus) $requiredItemStatus}
#	if ![string equal {} $similarityCriteria] {set criterionArray(parsedibiurl.similaritycriteria) $similarityCriteria}	;# commented by GJFB on 2026-02-17 - no longer in use
	if ![string equal {} $verbList] {set criterionArray(parsedibiurl.verblist) $verbList}
	
# not part of the norm
	ConditionalSet backgroundLanguage ibiURLArray(parsedibiurl.backgroundlanguage) {}	;# if ibiURLArray(parsedibiurl.backgroundlanguage) is neither en nor pt-BR or is not defined, then the browser preference will be used - see languagePreference below
	ConditionalSet cssFileURL ibiURLArray(parsedibiurl.cssfileurl) {}
	ConditionalSet metadataFieldNameList ibiURLArray(parsedibiurl.metadatafieldnamelist) {}
	ConditionalSet metadataHeader ibiURLArray(parsedibiurl.metadataheader) {}	;# not in use
	ConditionalSet requiredSite ibiURLArray(parsedibiurl.requiredsite) {}
#	ConditionalSet requiredTimeStamp ibiURLArray(parsedibiurl.requiredtimestamp) {}
# puts --$backgroundLanguage--	
	if ![string equal {} $backgroundLanguage] {set criterionArray(parsedibiurl.backgroundlanguage) $backgroundLanguage}
	if ![string equal {} $cssFileURL] {set criterionArray(parsedibiurl.cssfileurl) $cssFileURL}
	if ![string equal {} $metadataFieldNameList] {set criterionArray(parsedibiurl.metadatafieldnamelist) $metadataFieldNameList}
	if ![string equal {} $metadataHeader] {set criterionArray(parsedibiurl.metadataheader) $metadataHeader}	
	if ![string equal {} $requiredSite] {set criterionArray(parsedibiurl.requiredsite) $requiredSite}
#	if ![string equal {} $requiredTimeStamp] {set criterionArray(parsedibiurl.requiredtimestamp) $requiredTimeStamp}

#	set criterionArray(applicationrequirement.trueibiflag) $trueIBIFlag
#	set criterionArray(applicationrequirement.countoneclickflag) $countOneClickFlag
#	set criterionArray(auxiliarymemory.currentpath) $currentPath

#	ConditionalSet ipAddress env(REMOTE_ADDR) {}	;# ipaddress needed in GetURLPropertyList
	set clientIPAddress [GetClientIP]	;# clientIPAddress needed in GetURLPropertyList
	set criterionArray(clientinformation.ipaddress) $clientIPAddress

# languagePreference
	if [info exists env(HTTP_ACCEPT_LANGUAGE)] {
		set languagePreference $env(HTTP_ACCEPT_LANGUAGE)	;# pt-br,en;q=0.5
	} else {
#		set env(HTTP_ACCEPT_LANGUAGE) {}	;# produces an error with Internet Explorer
#		set languagePreference {}	;# commented by GJFB on 2015-07-30
		set languagePreference $contextLanguage	;# added by GJFB on 2015-07-30 - contextLanguage is language as defined by FindLanguage in Copyright and is appropriate for ResolveIBI to return the copyright in the preferred language (when clicking "Terms of Use") - otherwise one gets the error message: {can't read "a": no such variable} {    while executing} {"set preferredLanguage $a[string toupper $b]	"} {    (procedure "ResolveIBI2" line 50)}
	}
# puts "languagePreference = --$languagePreference--"	;# puts require unpost/post when executing BibINPE
# puts $contextLanguage	;# en 
	set criterionArray(clientinformation.languagepreference) $languagePreference	;# just for display
	set criterionArray(clientinformation.contextlanguage) $contextLanguage	;# added by GJFB on 2017-03-19 - used in GET only
	
if 0 {
	puts {Content-Type: text/html}
	puts {}
}
# criterionList
	set criterionList [array get criterionArray]
# puts [CallTrace]<BR><BR>
# puts --$criterionList--<BR><BR>
# puts $verbList
# puts --$languageButton--
# RETURNURLPROPERTYLIST
#	set urlPropertyList [ReturnURLPropertyList2 $criterionList]
#	set urlPropertyList [ReturnURLPropertyList2 $criterionList $useURLibServerFlag]	;# commented by GJFB on 2017-02-20
#	set urlPropertyList [ReturnURLPropertyList2 $criterionList $useURLibServerFlag $useLocalServerOnlyFlag]	;# added by GJFB on 2017-02-20	;# commented by GJFB on 2021-02-16
	set urlPropertyList [ReturnURLPropertyList2 $criterionList $useURLibServerFlag $useLocalServerOnlyFlag $extendedSearchFlag]	;# added by GJFB on 2021-02-16
# puts --$urlPropertyList--
	if [regexp {^<(.*)>$} $urlPropertyList m errorMessage] {
		error $errorMessage
	}

	array set urlPropertyArray $urlPropertyList
# puts $urlPropertyArray(state)
	if {[info exists urlPropertyArray(state)] && [string equal {Deleted} $urlPropertyArray(state)]} {
# puts {deleted identifier}
		if $displayWarningMessage {
			set identifier $ibi
#			set metadataLastUpdate $urlPropertyArray(metadatalastupdate)
			set timeStamp $urlPropertyArray(timestamp)
			set site $urlPropertyArray(archiveaddress)
#			regsub {(\d{4,}):(\d{2})\.(\d{2}).*} $metadataLastUpdate {\1-\2-\3} deletionDate
#			regsub {(\d{4,}):(\d{2})\.(\d{2}).*} $timeStamp {\1-\2-\3} deletionDate
			regsub {(\d{4,})-(\d{2})-(\d{2}).*} $timeStamp {\1-\2-\3} deletionDate
			if [string equal {} $callingProcedureName] {
				set reverseInfo {}
			} else {
				set reverseInfo " $callingProcedureName"
			}
#			set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] ResolveIBI: ibi $ibi not found while client at $env(REMOTE_ADDR) is asking to execute the script$reverseInfo with the path info:\n$env(PATH_INFO)\nand with the query string:\n\"$env(QUERY_STRING)\"\n"
#			Store log $homePath/@errorLog auto 0 a
			set log "ibi $ibi not found while client at $env(REMOTE_ADDR) is asking to execute the script$reverseInfo with the path info:\n$env(PATH_INFO)\nand with the query string:\n\"$env(QUERY_STRING)\"\n"
			StoreLog {notice} {ResolveIBI} $log
			source ../$col/$languageRep2/doc/mirror/${contextLanguage}Cover.tcl
			catch {subst [set [list ${languageRep2}::deleted identifier]]} output
			error $output	;# needs languageRep1 and localSite
		}
#		set urlPropertyList {}
	}
	
# puts ---$urlPropertyList---<BR>
	if ![info exists depthLevel] {set depthLevel 0}
# puts $contextLanguage
#	if [string equal {} $contextLanguage] #
		set outputList [ResolveIBI2 $parsedIBIURL $languagePreference $urlPropertyList]
#	# else #
#		set outputList [ResolveIBI2 $parsedIBIURL $contextLanguage $urlPropertyList]	;# added by GJFB on 2014-09-22 - languagePreference and languagebutton (ibiurl.backgroundlanguage) are included in contextLanguage and the latter has priority over the former - useful to display the default copyright in the proper language when clicking "Term of Use"
#	#
# puts --$outputList--
	
	if $displayWarningMessage {
		if [string equal {} $outputList] {
# ibi not found
			DisplayWarningMessage $ibi $callingProcedureName $contextLanguage $languageRep1 $languageRep2 $localSite $verbList $requiredItemStatus	;# runs an error command
		}
	}
	
# Add query string
# puts >>>>>>>>>>>>$depthLevel
	if !$depthLevel {
		array set outputArray $outputList
		set queryString [MountQueryString $queryList $backgroundLanguage $cssFileURL]
		if ![string equal {} $queryString] {
			if [regexp {([^?]+)\?(.*)} $outputArray(url) m part1 part2] {
				set outputArray(url) $part1?$queryString&$part2
			} else {
				set outputArray(url) $outputArray(url)?$queryString
			}
		}
		set outputList [array get outputArray]
	}
# Add query string - end

# puts --$outputList--

# Sort names
 	set list {}
	foreach {name value} $outputList {
		lappend list [list $name $value]
	}
	set outputList2 {}
	foreach item [lsort -index 0 $list] {
		foreach {name value} $item {break}
		lappend outputList2 $name $value
	}
# Sort names - end

	incr depthLevel -1
	return $outputList2
}

# ResolveIBI - end
# ----------------------------------------------------------------------
# ResolveIBI2
# used by ResolveIBI only
# ResolveIBI calls ResolveIBI2 and ResolveIBI2 calls ResolveIBI (recursive use)
# verbList value is [GetLastEdition] [GetTranslation[(xx[-XX])] [GetMetadata [GetTranslation[(xx[-XX])]]
# url entry value is url[.lastedition][.translation[(xx[-XX])][.metadata[.translation[(xx[-XX])]]

proc ResolveIBI2 {parsedIBIURL languagePreference urlPropertyList} {
	global printFlag	;# set in Get and Get- only
	global depthLevel
	global env
	
#	upvar depthLevel depthLevel
	
	array set ibiURLArray $parsedIBIURL
# part of the norm
	ConditionalSet requiredItemStatus ibiURLArray(parsedibiurl.requireditemstatus) {}
	ConditionalSet verbList ibiURLArray(parsedibiurl.verblist) {}
# puts --$verbList--
# --GetLastEdition GetTranslation GetMetadata-- --GetTranslation GetMetadata-- --GetMetadata-- 
# url
#	if [regexp {Original} $requiredItemStatus] {set url URL} else {set url url}

# puts --$urlPropertyList--
	if [string equal {} $urlPropertyList] {return}	;# ibi not found
	
	array set urlPropertyArray $urlPropertyList

#	if {[llength $verbList] == 0 && [string equal {yes} $urlPropertyArray(redirecttometadata)]} {
#		set verbList {GetMetadata}
#	}
	
	set type [ConvertVerbListToType $verbList]
# puts "type = +++$type+++"	;# puts require unpost/post when executing BibINPE
# => type = +++.metadata.translation+++
# puts [info exists urlPropertyArray(ibi$type)]
# puts urlPropertyArray(ibi$type)

#	set atLeastOneTranslationWithoutExplicitLanguageflag [regexp {translation\.|translation$]} $type]
#	set atLeastOneTranslationWithoutExplicitLanguageflag [regexp {translation(\.|$)]} $type]	;# commented by GJFB on 2021-11-26
	set atLeastOneTranslationWithoutExplicitLanguageflag [regexp {translation(\.|$)} $type]	;# added by GJFB on 2021-11-26
# puts "atLeastOneTranslationWithoutExplicitLanguageflag = $atLeastOneTranslationWithoutExplicitLanguageflag"	;# puts require unpost/post when executing BibINPE
# => 1 	
if {[info exists printFlag] && $printFlag} {
	puts "ResolveIBI2: url$type $depthLevel<BR>"
	puts <BR><BR>
}

# puts "\[info exists urlPropertyArray(url$type)\] = [info exists urlPropertyArray(url$type)]"	;# puts require unpost/post when executing BibINPE
# => 0 (next edition repository removed) 	
# => 1 (next edition repository not removed) 	
	set testingUseOfIBIFlag $depthLevel
	set testingUseOfIBIFlag 1	;# 0 for testing the use of ibi for finding the url
	if {$testingUseOfIBIFlag && [info exists urlPropertyArray(url$type)] && !$atLeastOneTranslationWithoutExplicitLanguageflag} {	;# commented by GJFB on 2022-02-22 - uncommented by GJFB on 2022-02-27 (implementation of a new solution)
# puts [array names urlPropertyArray]
# => urlkey timestamp ibi archiveaddress state metadatafieldlist ibi.archiveservice contenttype ibi.platformsoftware url
#	if {!([regexp {GetTranslation\(.*\)} [lindex $verbList 0]] && [lsearch [array names urlPropertyArray] metadatafieldlist] != -1) && $testingUseOfIBIFlag && [info exists urlPropertyArray(url$type)] && !$atLeastOneTranslationWithoutExplicitLanguageflag} #	;# added by GJFB on 2022-02-22 - resolution of ibi such as LK47B6W/E6H5HH+(pt-BR), when referenced like in http://gjfb:1905/ibi/LK47B6W/E6H5HH+(pt-BR), uses metadatafieldlist (required to display the header menu bar) and must be processed recursively (ResolveIBI2 calling ResolveIBI) to display the right header/metadata (not the header/metadata of LK47B6W/E6H5HH) - ommented by GJFB on 2022-02-27 (implementation of a new solution)
# the url exists and the required languages of all translations are specified
# puts [SetOutputList $urlPropertyList $requiredItemStatus $type]
# => urlkey 1610159802369-6872813786008231 timestamp 2014-08-21T00:39:44Z ibi {rep iconet.com.br/banon/2007/10.27.03.57 ibin CBnmVX32PXQZeBBx/RTewE} archiveaddress gjfb:1905 state Original ibi.archiveservice {rep dpi.inpe.br/banon/1999/01.09.22.14} contenttype Data ibi.platformsoftware {rep dpi.inpe.br/banon/1998/08.02.08.56} url http://gjfb:1905/col/iconet.com.br/banon/2007/10.27.03.57/doc/bbb%c3o.txt
# (CBnmVX32PXQZeBBx/RTewE is theibin of the next edition)
		return [SetOutputList $urlPropertyList $requiredItemStatus $type] 
	} else {
# urlPropertyArray(url$type) doesn't exist (next edition not found))
# puts -1-$languagePreference--	;# puts require unpost/post when executing BibINPE
if 0 {
# commented by GJFB on 2021-11-26 - taking the first is too restrictive
		if [string equal {} $languagePreference] {	;# added by GJFB on 2021-01-08 - when the next edition (resp. previous) repository was removed but the nextedition (resp. previousedition) field is still not empty, and the BibINPE button is pressed, as CreateFullBibINPEEntry doesn't know the context language when calling FindSite2, the languagePreference is empty (default) and the preferredLanguage cannot be found
			set preferredLanguage {}
		} else {
			set preferredLanguage [lindex [split $languagePreference ,] 0]	;# >>> take the first
			set preferredLanguage [lindex [split $preferredLanguage \;] 0]	;# pt-br
			regexp {(..)(.*)} $preferredLanguage m a b
			set preferredLanguage $a[string toupper $b]	;# pt-br -> pt-BR
		}
		set verbList2 {}
		foreach verb $verbList {
			if [string equal {} $preferredLanguage] {	;# added by GJFB on 2021-01-08 - when the next edition (resp. previous) repository was removed but the nextedition (resp. previousedition) field is still not empty, and the BibINPE button is pressed, as CreateFullBibINPEEntry doesn't know the context language when calling FindSite2, the languagePreference is empty (default) and the preferredLanguage cannot be found
				set verb2 $verb
			} else {
				regsub {^GetTranslation$} $verb "GetTranslation($preferredLanguage)" verb2	;# Translation -> Translation(pt-BR)
			}
			lappend verbList2 $verb2	
		}
# type 2
# puts --$verbList2--
# => GetTranslation(pt-BR) (example)
# => GetMetadata GetTranslation(fr-FR) (example)
		set type2 [ConvertVerbListToType $verbList2]
# puts --$type2--
# => metadata.translation(fr-FR)	
		if {$testingUseOfIBIFlag && [info exists urlPropertyArray(url$type2)]} {
# the url exists and the preferred language is used every where the required languages are not specified
# http://gjfb/83LX3pFwXQZeBBx/e2NgJ??+
			return [SetOutputList $urlPropertyList $requiredItemStatus $type2]
		}
} else {
# added by GJFB on 2021-11-26
		if [string equal {} $languagePreference] {	;# added by GJFB on 2021-01-08 - when the next edition (resp. previous) repository was removed but the nextedition (resp. previousedition) field is still not empty, and the BibINPE button is pressed, as CreateFullBibINPEEntry doesn't know the context language when calling FindSite2, the languagePreference is empty (default) and the preferredLanguage cannot be found
			set preferredLanguage {}
		} else {
			foreach preferredLanguage [split $languagePreference ,] {
				set preferredLanguage [lindex [split $preferredLanguage \;] 0]	;# pt-br
				regsub -- {-..} $preferredLanguage {} relaxedLanguage	;# pt-br -> pt
				foreach name [array names urlPropertyArray url.metadata.translation(*)] {
# puts [list $relaxedLanguage $name]
					if [regexp "url.metadata.translation\\($relaxedLanguage" $name] {
# GetTranlation(pt-BR) and url.metadata.translation(pt) (example)
# GetTranlation(pt) and url.metadata.translation(pt-BR) (example)
						regsub {url} $name {} type2
# puts $type2
# => .metadata.translation(en)
						return [SetOutputList $urlPropertyList $requiredItemStatus $type2]
					}
				}
			}
			if [info exists urlPropertyArray(url.metadata.translation)] {
				set type2 .metadata.translation
				return [SetOutputList $urlPropertyList $requiredItemStatus $type2]
			}
			if [info exists urlPropertyArray(url.metadata.translation(en))] {
				set type2 .metadata.translation(en)	;# en chosen as default
				return [SetOutputList $urlPropertyList $requiredItemStatus $type2]
			}
		}
}
	}
# puts $verbList
	set firstVerb [lindex $verbList 0]
	
# GETMETADATA
#	if [string equal {GetMetadata} $firstVerb] #
	if [regexp {GetMetadata} $firstVerb] {
# >>> the first is GetMetadata
# http://gjfb/dpi.inpe.br/banon/1999/04.02.15.49:
		if [regexp "GetMetadata\\((.+)\\)" $firstVerb m requiredFormat] {
			set type ".metadata($requiredFormat)"
		} else {
			set type ".metadata"
		}
		if {[info exists urlPropertyArray(ibi$type)] && ![string equal {} $urlPropertyArray(ibi$type)]} {
			set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray(ibi$type) 1]
			set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]	;# drop the first verb
			incr depthLevel
			return [ResolveIBI [array get ibiURLArray]]
		} else {
			return	;# ibi not found - urlPropertyList doesn´t match the norm
		}
	}	;# end - GetMetadata
	
# GETLASTEDITION
#	if [string equal {GetLastEdition} [lindex $verbList 0]] 
#	ConditionalSet similarityCriteria ibiURLArray(parsedibiurl.similaritycriteria) {language}
#	if {[string equal {GetAppropriateSimilar} [lindex $verbList 0]] && [string equal {lastEdition} $similarityCriteria]} #
	if [string equal {GetLastEdition} $firstVerb] {
# >>> the first is GetLastEdition
# no url.lastedition exists
#		if {[info exists urlPropertyArray(ibi.nextedition)] && \
#		![string equal {} $urlPropertyArray(ibi.nextedition)] && \
#		$depthLevel < 4} #
# next edition known and depth level less then 4
		if {$depthLevel < 4} {
# depth level less then 4
#			if [TestIBIEquality $urlPropertyArray(ibi.nextedition) $urlPropertyArray(ibi)] #
			if ![info exists urlPropertyArray(ibi.nextedition)] {
# no next edition
#				set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]	;# drop the first verb - avoid possible infinite loop - code before trying finding metadata url
				set newVerbList [lrange $verbList 1 end]	;# drop the first verb - avoid possible infinite loop
				set firstVerb [lindex $newVerbList 0]
# Try finding metadata url
# not needed anymore with URLibService
# useful for Archive which doesn't have IBI for metadata or when url.lastedition.metadata is not defined in urlPropertyArray
				if [regexp {GetMetadata} $firstVerb] {
# >>> the first is GetMetadata
					if [regexp "GetMetadata\\((.+)\\)" $firstVerb m requiredFormat] {
						set type ".metadata($requiredFormat)"
					} else {
						set type ".metadata"
					}
					if {1 && [info exists urlPropertyArray(url$type)]} {
						return [SetOutputList $urlPropertyList $requiredItemStatus $type] 
					} else {
						set ibiURLArray(parsedibiurl.verblist) $newVerbList	;# url not found
					}
				}
# Try finding metadata url - end

# Try finding translation url
				if [regexp {GetTranslation} $firstVerb] {
# >>> the first is GetTranslation
# http://gjfb/J8LNKAN8PW/U3RNES!+
					if [regexp "GetTranslation\\((.+)\\)" $firstVerb m requiredLanguage] {
						set type ".tranlation($requiredLanguage)"
					} else {
						set type ".tranlation"
					}
					if {1 && [info exists urlPropertyArray(url$type)]} {
						return [SetOutputList $urlPropertyList $requiredItemStatus $type] 
					} else {
						set ibiURLArray(parsedibiurl.verblist) $newVerbList	;# url not found
					}
				}
# Try finding translation url - end
			} else {
## there is a true next edition - find it using the same verb list
# there is a next edition - find it using the same verb list
				set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray(ibi.nextedition) 1]
#				set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]
				set ibiURLArray(parsedibiurl.verblist) $verbList
			}
			incr depthLevel
			return [ResolveIBI [array get ibiURLArray]]
		} else {
			return	;# ibi not found - urlPropertyList doesn´t match the norm
		}
	}	;# end - GetLastEdition
	
# GETTRANSLATION
#	if {[string equal {GetAppropriateSimilar} [lindex $verbList 0]] && [string equal {language} $similarityCriteria]} #
	if [regexp {GetTranslation} $firstVerb] {
# puts --$type--
# >>> the first is GetTranslation
#		ConditionalSet requiredContentLanguage ibiURLArray(parsedibiurl.language) {}	
#		if ![string equal {} $requiredContentLanguage] #
		if [regexp "GetTranslation\\((\[a-z\]\[a-z\]-?\[\[:alpha:\]\]?\[\[:alpha:\]\]?)\\)" $firstVerb m requiredContentLanguage] {
# required language specified
# GetTranslation(en) (example)
#			if [string equal -nocase $urlPropertyArray(language) $requiredContentLanguage] #	;# commented by GJFB on 2015-02-06 - $urlPropertyArray(language) might be a list of language: pt fr en
#			if {[lsearch -exact -nocase $urlPropertyArray(language) $requiredContentLanguage] != -1} #
## GetTranslation(en) and the ibi is en (example)
			set type2 [ConvertVerbListToType $verbList]
# puts $type2
			if {1 && [info exists urlPropertyArray(url$type2)]} {	;# commented by GJFB on 2022-02-22 - uncommented by GJFB on 2022-02-27 (implementation of a new solution)
#			if {[lsearch [array names urlPropertyArray] metadatafieldlist] == -1 && [info exists urlPropertyArray(url$type2)]} #	;# added by GJFB on 2022-02-22 - resolution of ibi such as LK47B6W/E6H5HH+(pt-BR), when referenced like in http://gjfb:1905/ibi/LK47B6W/E6H5HH+(pt-BR), uses metadatafieldlist (required to display the header menu bar) and must be processed recursively (ResolveIBI2 calling ResolveIBI) to display the right header/metadata - ommented by GJFB on 2022-02-27 (implementation of a new solution)
# GetTranlation(pt-BR) and url.translation(pt-BR) exists (example)
				return [SetOutputList $urlPropertyList $requiredItemStatus] 
			} else {
# GetTranslation(en) and the ibi is not en (example)
				if [info exists urlPropertyArray(ibi.translation($requiredContentLanguage))] {
# ibi.translation(en) exists (example)
					set entry ibi.translation($requiredContentLanguage)
					set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray($entry) 1]
					set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]	;# drop the first verb
					incr depthLevel
					return [ResolveIBI [array get ibiURLArray]]
				}
			}
			return	;# no available language - return nothing when the required language doesn't match
		}
		
# GetTranslation - no required language specified - use languagePreference

# puts -2-$languagePreference--
# => pt-br,fr;q=0.8,en;q=0.6,pt;q=0.4,en-us;q=0.2 (example)
		foreach preferredLanguage [split $languagePreference ,] {
			set preferredLanguage [lindex [split $preferredLanguage \;] 0]	;# pt-br
			regexp {(..)(.*)} $preferredLanguage m a b
			set preferredLanguage $a[string toupper $b]	;# pt-br -> pt-BR
			set verbList2 {}
			foreach verb $verbList {
				regsub {^GetTranslation$} $verb "GetTranslation($preferredLanguage)" verb2	;# Translation -> Translation(pt-BR)
				lappend verbList2 $verb2	
			}
# type2
# puts $verbList2
# => GetTranslation(pt-BR) (example)
			set type2 [ConvertVerbListToType $verbList2]	
# puts >>>$type	
# => .translation(pt-BR) (example)
			if {1 && [info exists urlPropertyArray(url$type2)]} {	;# commented by GJFB on 2022-02-22 - uncommented by GJFB on 2022-02-27 (implementation of a new solution)
#			if {[lsearch [array names urlPropertyArray] metadatafieldlist] == -1 && [info exists urlPropertyArray(url$type2)]} #	;# added by GJFB on 2022-02-22 - resolution of ibi such as LK47B6W/E6H5HH+, when referenced like in http://gjfb:1905/ibi/LK47B6W/E6H5HH+, uses metadatafieldlist (required to display the header menu bar) and must be processed recursively (ResolveIBI2 calling ResolveIBI) to display the right header/metadata (not the header/metadata of LK47B6W/E6H5HH) - ommented by GJFB on 2022-02-27 (implementation of a new solution)
# puts $urlPropertyArray(url$type2)
# puts [array get urlPropertyArray]
# the url exists and the second or following preferred language is used every where the required languages are not specified
# GetTranlation(pt-BR) and url.translation(pt-BR) exists (example)
				return [SetOutputList $urlPropertyList $requiredItemStatus $type2] 
			}
# the verb is GetTranlation(pt-BR) and url.translation(pt-BR) doesn't exist (example)
			set entry ibi.translation($preferredLanguage)
			if [info exists urlPropertyArray($entry)] {
# ibi.translation(pt-BR) exists (example)
				set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray($entry) 1]
				set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]	;# drop the first verb
				incr depthLevel
				return [ResolveIBI [array get ibiURLArray]]
			}
		}
# try relaxing
# puts {try relaxing}
		foreach preferredLanguage [split $languagePreference ,] {
			set preferredLanguage [lindex [split $preferredLanguage \;] 0]	;# pt-br
			regsub -- {-..} $preferredLanguage {} relaxedLanguage	;# pt-br -> pt
			foreach name [array names urlPropertyArray url.translation(*)] {
# puts [list $relaxedLanguage $name]
				if [regexp "url.translation\\($relaxedLanguage" $name] {
# GetTranlation(pt-BR) and url.translation(pt) (example)
# GetTranlation(pt) and url.translation(pt-BR) (example)
					regsub {url} $name {} type2
					return [SetOutputList $urlPropertyList $requiredItemStatus $type2]
				}
			}
			foreach name [array names urlPropertyArray ibi.translation(*)] {
# puts [list $relaxedLanguage $name]
				if [regexp "ibi.translation\\($relaxedLanguage" $name] {
# GetTranlation(pt-BR) and ibi.translation(pt) (example)
# GetTranlation(pt) and ibi.translation(pt-BR) (example)
					set entry $name
					set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray($entry) 1]
					set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]	;# drop the first verb
					incr depthLevel
					return [ResolveIBI [array get ibiURLArray]]
				}
			}
		}
# there is no available language - use url.translation (the current ibi)
# puts OK
# puts $type
# => .translation
# => .translation.metadata
#		if {1 && ![string equal {} [set name [array names urlPropertyArray url.translation*]]]} #
		if {1 && [info exists urlPropertyArray(url$type)]} {
#			regsub {url} $name {} type
			return [SetOutputList $urlPropertyList $requiredItemStatus $type] 
		}
# there is no available language - use ibi.translation (the current ibi)
if 0 {
#		if {[info exists urlPropertyArray(ibi.translation)] && ![string equal {} $urlPropertyArray(ibi.translation)]} #
		if {![string equal {} [set name [array names urlPropertyArray ibi.translation*]]] && ![string equal {} $urlPropertyArray($name)]} {
#			set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray(ibi.translation) 1]
			set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray($name) 1]
			set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]	;# drop the first verb
			incr depthLevel
			return [ResolveIBI [array get ibiURLArray]]
		} else {
			return	;# ibi not found - urlPropertyList doesn't match the norm
		}
}	
		set type2 [ConvertVerbListToType [lrange $verbList 0 end-1]]	
# puts $type2
		if [info exists urlPropertyArray(ibi$type2)] {
			set ibiURLArray(parsedibiurl.ibi) [lindex $urlPropertyArray(ibi$type2) 1]
			set ibiURLArray(parsedibiurl.verblist) [lrange $verbList 1 end]	;# drop the first verb
			incr depthLevel
			return [ResolveIBI [array get ibiURLArray]]
		} else {
			return	;# ibi not found - urlPropertyList doesn´t match the norm
		}
		
		
	}	;# end - GetTranslation

# GETFILELIST	
	if [string equal {GetFileList} $firstVerb] {
# http://gjfb/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetFileList
		return [SetOutputList $urlPropertyList $requiredItemStatus] 
	}	;# end - GetFileList
}

# ResolveIBI2 - end
# ----------------------------------------------------------------------
# SetOutputList
# used in ResolveIBI2 only

proc SetOutputList {urlPropertyList requiredItemStatus {type {}}} {
	array set urlPropertyArray $urlPropertyList
	set outputArray(archiveaddress) $urlPropertyArray(archiveaddress)

# puts --$type--
# => .translation(pt-BR)
# puts [CallTrace]

# contenttype
#	if [info exists urlPropertyArray(contenttype$type)] {
		set outputArray(contenttype) $urlPropertyArray(contenttype$type)
#	}

#	set outputArray(encodingsystem) $urlPropertyArray(encodingsystem)

# ibi
	if [info exists urlPropertyArray(ibi$type)] {
# urlPropertyArray(ibi$type) always exists with the URLib platform but may not exist with others
# for example when type is .metadata
		set outputArray(ibi) $urlPropertyArray(ibi$type)
	}
	
# ibi.archiveservice
	set outputArray(ibi.archiveservice) $urlPropertyArray(ibi.archiveservice)
	
# ibi.platformsoftware
	set outputArray(ibi.platformsoftware) $urlPropertyArray(ibi.platformsoftware)
	
# metadatafieldlist - not part of the norm
	if [info exists urlPropertyArray(metadatafieldlist)] {
		set outputArray(metadatafieldlist) $urlPropertyArray(metadatafieldlist)
	}
	
#	set outputArray(redirecttometadata) $urlPropertyArray(redirecttometadata)

# state
#	if [info exists urlPropertyArray(state$type)] {
		set outputArray(state) $urlPropertyArray(state$type)
#	}

# timestamp
#	if [info exists urlPropertyArray(timestamp$type)] {
		set outputArray(timestamp) $urlPropertyArray(timestamp$type)
#	}

#	if [regexp {Original} $requiredItemStatus] {set url URL} else {set url url}

# url
	set outputArray(url) $urlPropertyArray(url$type)
	
# metadatafieldlist
	if [info exists urlPropertyArray(metadatafieldlist$type)] {
		set outputArray(metadatafieldlist) $urlPropertyArray(metadatafieldlist$type)	;# added by GJFB on 2022-02-27
	}
	
# urlkey
	set outputArray(urlkey) $urlPropertyArray(urlkey)
	
	return [array get outputArray]
}

# SetOutputList - end
# ----------------------------------------------------------------------
# ConvertVerbListToType
# used in ResolveIBI2 and GetURLPropertyList only

proc ConvertVerbListToType {verbList} {
	if [string equal {} $verbList] {
		set type {}
	} else {
		set nameList {}
		foreach verb $verbList {
			if [regsub {GetMetadata} $verb {metadata} name] {lappend nameList $name; continue}
			if [regsub {GetLastEdition} $verb {lastedition} name] {lappend nameList $name; continue}
			if [regsub {GetTranslation} $verb {translation} name] {lappend nameList $name; continue}
#			lappend nameList $name	;# commented by GJFB on 2015-02-10 - not needed
		}
		if [string equal {} $nameList] {
			set type {}
		} else {
			set type .[join $nameList .]	;# GetLastEdition GetTranslation(xx) GetMetadata -> lastedition.translation(xx).metadata
		}
	}
	return $type
}

# ConvertVerbListToType - end
# ----------------------------------------------------------------------
# DisplayWarningMessage
# used in ResolveIBI, CreateListOfurlPropertiesFromAgencies and CreateResponseList only

proc DisplayWarningMessage {
	ibi callingProcedureName contextLanguage languageRep1 languageRep2 localSite
	{verbList {}} {requiredItemStatus {}}
} {
	global homePath
	global env
	
	set identifier $ibi
	if [string equal {} $callingProcedureName] {
		set reverseInfo {}
	} else {
		set reverseInfo " $callingProcedureName"
	}
#	set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] ResolveIBI: ibi $ibi not found while client at $env(REMOTE_ADDR) is asking to execute the script$reverseInfo with the path info:\n$env(PATH_INFO)\nand with the query string:\n\"$env(QUERY_STRING)\"\n"
#	Store log $homePath/@errorLog auto 0 a
#	set log "ibi $ibi not found while client at $env(REMOTE_ADDR) is asking to execute the script$reverseInfo with the path info:\n$env(PATH_INFO)\nand with the query string:\n\"$env(QUERY_STRING)\"\n"
	set log "ibi $ibi not found while client at $env(REMOTE_ADDR) is asking to execute the script$reverseInfo with the path info:\n$env(PATH_INFO)\nand with the query string:\n\"$env(QUERY_STRING)\"\n[CallTrace]\n"
	StoreLog {notice} {DisplayWarningMessage} $log
	source $homePath/col/$languageRep2/doc/mirror/${contextLanguage}Cover.tcl
# puts $verbList
#	if {[regexp "GetTranslation\\((\[a-z\]\[a-z\]-?\[\[:alpha:\]\]?\[\[:alpha:\]\]?)\\)" [lindex $verbList end] m requiredContentLanguage]} #
	if {[llength $verbList] == 1 && [regexp -all "GetTranslation\\((\[a-z\]\[a-z\]-?\[\[:alpha:\]\]?\[\[:alpha:\]\]?)\\)" $verbList  m requiredContentLanguage]} {
		set language $requiredContentLanguage
		catch {subst [set [list ${languageRep2}::language warning]]} output
	} elseif {[llength $verbList] > 0} {
		catch {subst [set [list ${languageRep2}::full warning]]} output
	} elseif {[string equal {Original} $requiredItemStatus]} {
		catch {subst [set [list ${languageRep2}::original warning]]} output
	} else {			
# examples:
# http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.56
# http://gjfb:1905/rep/iconet.com.br/banon/2001/02.10.22.56
# http://gjfb:1905/iconet.com.br/banon/2001/02.10.22.55+(fr)
# http://gjfb:1905/dpi.inpe.br/banon/2000/05.25.20.06+(fr)
# http://gjfb:1905/rep/83LX3pFwXQZeBBx/BbsHa
# http://gjfb:1905/rep/dpi.inpe.br/banon/2004/02.16.09.30.00
		catch {subst [set [list ${languageRep2}::identifier warning]]} output
	}
# puts [set [list ${languageRep2}::identifier warning]]
# puts [set [list ${languageRep2}::metadata warning]]
if 1 {
	error $output	;# needs languageRep1 and localSite
} else {
# tracing error
	error [CallTrace]$output	;# needs languageRep1 and localSite
}
}

# DisplayWarningMessage - end
# ----------------------------------------------------------------------
# TestIBIEquality
# ibi1 or ibi2 is a list for array like
# rep iconet.com.br/banon/2009/09.09.22.01 ibip LK47B6W/362SFKH
# retuns 1 if ibi1 == ibi2
# used in ResolveIBI2 and GetURLPropertyList only

proc TestIBIEquality {ibi1 ibi2} {
	array set ibi1Array $ibi1
	array set ibi2Array $ibi2
	foreach name1 [array names ibi1Array] {
		foreach name2 [array names ibi2Array] {
			if [string equal $name1 $name2] {
				if [string equal $ibi1Array($name1) $ibi2Array($name2)] {
					return 1
				}
			}
		}
	}
	return 0
}

# TestIBIEquality - end
# ----------------------------------------------------------------------
# GetServerAddressFromHTTPHost
# added by GJFB on 2012-06-07 - solves the virtual host use (ex: sibgrapi.sid.inpe.br 802)
## used by AcknowledgeArchive and Cover
# used by FindURLPropertyList, Cover, CreateFullBibINPEEntry and Puts (in cgi/copyright.tcl)
# used also by addHeader (in col/dpi.inpe.br/banon-pc2@1905/2006/03.22.15.15/doc/cgi/addHeader.tcl)
# examples:
# GetServerAddressFromHTTPHost gjfb.home 800
# => gjfb.home 800
# GetServerAddressFromHTTPHost gjfb.home
# => gjfb.home 800
# GetServerAddressFromHTTPHost mtc-m16d.sid.inpe.br
# => mtc-m16d.sid.inpe.br 806
	
if 0 {
# not used
proc GetServerAddressFromHTTPHost2 {site} {
#			global homePath
			
			if {[llength $site] == 2} {return $site}	;# already a server address (like {gjfb 800})
			package require http	;# see online manual
#			set token [http::geturl http://$site/info]	;# commented by GJFB on 2018-05-21
			if [catch {http::geturl http://$site/info} token] {
				set log "$token\nwhile accessing site: --$site--"
				error [StoreLog {alert} {GetServerAddressFromHTTPHost} $log]	;# added by GJFB on 2018-05-21
			}
			regexp {[^:]*} $site serverName

if 0 {
# commented by GJFB on 2014-06-21
			if [string equal {401} [::http::ncode  $token]] {
# Authorization Required
				Load $homePath/@urlibPort urlibPort
			} else {
				regexp "(^|\n)URLIB_PORT = (\\d+)" [http::data $token] m n urlibPort
			}
} else {
## now /info is allow from all
			set info [http::data $token]
#			regexp "(^|\n)URLIB_PORT = (\\d+)" $info m n urlibPort
			regsub -all -nocase {<br>} $info {} info2
			set fieldList [split $info2 \n]
			set i 0
			foreach field $fieldList {
				regexp {(.*) = (.*)} $field m fieldName fieldValue
#				if [string equal {SERVER_NAME} $fieldName] {set serverName $fieldValue; incr i} 
				if [string equal {URLIB_PORT} $fieldName] {set urlibPort $fieldValue; incr i}
				if {$i > 0} {break}
			}
}
			http::cleanup $token
			return [list $serverName $urlibPort]
}
}

# new version by GJFB on 2019-02-22 because authorization is required in site like gprb0705.sid.inpe.br with Apache 2.4.16
proc GetServerAddressFromHTTPHost {site} {
#	global homePath
	global localSite	;# set in Get- and Get
	global serverAddress	;# set in Get- and Get
	
	if [string equal $site $localSite] {return $serverAddress}	;# added by GJFB on 2024-09-05 to speed up execution and avoid executing http::geturl http://$site/@urlibPort at installation (this command results in the error: 'connect failed connection refused' while accessing, for example, site: --gjfb:1906--
	
	if {[llength $site] == 2} {return $site}	;# already a server address (like {gjfb 800})
	regexp {[^:]*} $site serverName
#	Load $homePath/@urlibPort urlibPort	;# commented by GJFB on 2019-08-26
	package require http
	if [catch {http::geturl http://$site/@urlibPort} token] {
		set log "$token\nwhile accessing site: --$site--\n[CallTrace]"
		error [StoreLog {alert} {GetServerAddressFromHTTPHost} $log]	;# added by GJFB on 2018-05-21 - $site might be different from the site calling GetServerAddressFromHTTPHost, e.g. $site is sibgrapi.sid.inpe.br (with port 802) and the calling site urlib.net (with port 800)
	}
	if [string equal {404} [::http::ncode  $token]] {
		http::cleanup $token	;# added by GJFB on 2024-09-02
		error "http://$site/@urlibPort not found - do unpost/post of the local collection $site and try again"	;# added by GJFB on 2019-10-04
	}
	set urlibPort [join [http::data $token]]	;# added by GJFB on 2019-08-26
	http::cleanup $token	;# added by GJFB on 2024-09-02
	return [list $serverName $urlibPort]
}

# GetServerAddressFromHTTPHost - end
# ----------------------------------------------------------------------
# SetAttributeTable
# repositoryName value is the name of the repository containing the file called $tclFileName
# tclFileName value is the name of the file containing the attributeTable array
# returns the attributeTable
# used in Get, ReturnIntranetConfiguration and UpdateArchivingPolicy only
# useURLibServerFlag value is 0 (default) or 1, 1 means to find directly through the URLib server

proc SetAttributeTable {repositoryName tclFileName {useURLibServerFlag 0}} {
	upvar attributeTable attributeTable
	
	set tryInLocalCollectionFlag [expr !$useURLibServerFlag]
# FINDSITECONTAININGTHEORIGINAL2
	set serverAddress [FindSiteContainingTheOriginal2 $repositoryName 0 {} $useURLibServerFlag]	;# find in the scope of all sites if needed
# puts --$serverAddress--	;# runs with post
	if [string equal {} $serverAddress] {
#		return -code error "SetAttributeTable (1): site not found for $repositoryName"	;# added by GJFB on 2013-01-09 - otherwise ReturnHTTPHost returns the local site http address
		return -code error "SetAttributeTable (1): site not found for $repositoryName\n[CallTrace]"	;# added by GJFB on 2021-10-09
	}
	set siteHavingTheAtributeTable [ReturnHTTPHost $serverAddress]
	set url http://$siteHavingTheAtributeTable/col/$repositoryName/doc/$tclFileName
# puts --$url--	;# runs with post
#	if [catch {Source $url attributeTable}] #	;# commented by GJFB on 2014-07-09 to avoid trying in the local collection
	if [catch {Source $url attributeTable $tryInLocalCollectionFlag}] {
		global errorInfo
		return -code error "SetAttributeTable (2): $errorInfo"
	}
}

# SetAttributeTable - end
# ----------------------------------------------------------------------
# ReturnIntranetConfiguration
# based on the year of the work and the group of its authors, the procedure returns the intranet configuration
# example if group is DPI-INPE-MCT-BR and year is 2005 the procedure returns 150.163
# used in GetURLPropertyList and SetAccessPermission

proc ReturnIntranetConfiguration {year group} {
#	global homePath
	global env
	
# puts [CallTrace]
# =>
# call stack
# 4: ReturnIntranetConfiguration 2020 DIDPI-CGOBT-INPE-MCTIC-GOV-BR
# 3: SetAccessPermission urlib.net/www/2011/01.13.14.59 intranet xxDefaultPermission xxDocAccessPermission xxDownloadAccessPermission
# 2: UpdateRepMetadataRep urlib.net/www/2011/01.13.14.59 urlib.net/www/2011/01.13.14.59.57 banon 33 preserve 0 1 {} 1 intranet banon {administrator banon} enable {} {{%0 Report} {%3 VetewrinaryRadiologyAndUlrasound.pdf} {%@mirrorrepository iconet.com.br/banon/2006/11.26.21.31} {%4 urlib.net/www/2011/01.13.14.59} {%? Banon, Gabriela Paola Ribeiro,} {%@ INPE--/} {%A Diversos,} {%@secondarytype MAN} {%C São José dos Campos} {%D 2020} {%I Instituto Nacional de Pesquisas Espaciais} {%K xx.} {%@format Pen-drive; On-line.} {%T Testando os campos grupo, tradutor, código do detentor e formato} {%@area INFO} {%@documentstage not transferred} {%@group DIDPI-CGOBT-INPE-MCTIC-GOV-BR} {%@dissemination NTRSNASA} {%@orcid 0000-0001-6942-4440} {%@usergroup banon} {%@affiliation Instituto Nacional de Pesquisas Espaciais (INPE)} {%@holdercode {isadg {BR SPINPE} ibi 8JMKD3MGPCW/3DT298S} {xxx yyy}} {%) iconet.com.br/banon/2008/10.17.18.43} {%2 urlib.net/www/2011/01.13.14.59.57}} {} 0 {} 0 0 {} 0 0 0 0
# 1: ServeLocalCollection sock888 192.168.0.103 57034
# call stack - end
	if [string equal {} $year] {set year [clock format [clock seconds] -format %Y]}	;# set the current year - useful for work-in-progress like ePrint
if 0 {
# for standalone testing
	Source http://banon-pc3/col/urlib.net/www/2012/10.03.22.58/doc/year=${year}_group_intranet.tcl attributeTable
} else {
	set repositoryName urlib.net/www/2012/10.03.22.58	;# a urlib.net repository - contains the file year=${year}_group_intranet.tcl
	set tclFileName year=${year}_group_intranet.tcl	;# file defining the intranet of groups
	
	if [info exists env(STANDALONE_MODE_FLAG)] {
# the calling procedure is a cgi script
		set standaloneModeFlag $env(STANDALONE_MODE_FLAG)
	} else {
# the calling procedure is not a cgi script
		global standaloneModeFlag	;# set in LoadGlobalVariables
	}
		
	if $standaloneModeFlag {
# in standalone mode
		set useURLibServerFlag 0
	} else {
		set useURLibServerFlag 1	;# avoid waiting for nonexisting repository in the local scope
	}
# SOURCE
	if [catch {SetAttributeTable $repositoryName $tclFileName $useURLibServerFlag}] {
		global errorInfo
		return -code error "ReturnIntranetConfiguration: $errorInfo"
	}
}
# array set attributeTable {
#	year=2012,group,intranet,INPE-MCTI-GOV-BR {150.163}
#	year=2012,group,intranet,INPE-MCTI-GOV-BR {}
# }
	set intranet {}
	if [info exists attributeTable] {
		set nameList [array names attributeTable]
# Compute intranet (ip list) from attributeTable
		if ![string equal {} $group] {
			foreach name $nameList {
				regsub "^year=$year,group,intranet," $name {} name2	;# INPE-MCTI-GOV-BR
				foreach element $group {
					if [regexp $name2$ $element] {
						lappend intranet $attributeTable($name)
					}
				}
			}
			set intranet [join [lsort -unique $intranet] {}]
		}
	} else {
#		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] ReturnIntranetConfiguration: attributeTable for the year $year doesn't exist\n"
#		puts $log
#		Store log $homePath/@errorLog auto 0 a
		return -code error "ReturnIntranetConfiguration: attributeTable for the year $year doesn't exist"
	}
	return $intranet
}

# ReturnIntranetConfiguration - end
# ----------------------------------------------------------------------
# ComputeSecondaryDateFromArchivingPolicy
# used in GetURLPropertyList only
# examples of archivingPolicy value:
# allowpublisher allowfinaldraft 
# denypublisher allowfinaldraft
# denypublisher6 allowfinaldraft 
# allowpublisher denyfinaldraft
# allowpublisher denyfinaldraft12
# denypublisher denyfinaldraft
# denypublisher24 denyfinaldraft 
# denypublisher denyfinaldraft12 
# denypublisher24 denyfinaldraft12
# denypublisher12 denyfinaldraft12
# intranet is a list of (eventually truncated) IPs

# returns a list consisting of a deny permission statement and a deny permission clearance date

# if the archivingPolicy is allowpublisher allowfinaldraft and versionType is empty (no version type)
# then the deny permission clearance date is 1995-08-01 (resulting in an allow permssion) - done by GJFB on 2014-01-25

proc ComputeSecondaryDateFromArchivingPolicy {year month archivingPolicy versionType intranet} {
	
	if [string equal {} $intranet] {
		set string "deny from all"
	} else {
		set string "deny from all and allow from $intranet"
	}
	
#	if {[string equal {} $year] || [string equal {} $archivingPolicy] || [string equal {} $versionType]} #
## empty year or empty archivingPolicy or empty versionType
	if {[string equal {} $year] || [string equal {} $archivingPolicy]} {
# empty year or empty archivingPolicy
		set secondaryDate [list $string {}]	;# deny (unless the current read permission is allow from all - see 2017-02-07)
	} else {
		if [string equal {} $versionType] {
			regsub -all {allow} $archivingPolicy {deny0} archivingPolicy2	;# allow and deny0 are equivalent
			set numberOfMonths 0	;# embargo maximun number of months
			foreach policy $archivingPolicy2 {
				if [regexp {\d+} $policy numberOfMonths2] {
					if {$numberOfMonths < $numberOfMonths2} {set numberOfMonths $numberOfMonths2}	;# max
				} else {
# no embargo
					set secondaryDate [list $string {}]	;# deny
					return $secondaryDate
				}
			}
			set embargoFinalDate [ComputeEmbargoFinalDate $year $month $numberOfMonths]
			set secondaryDate [list $string $embargoFinalDate]
		} else {
# versionType value is publisher or finaldraft
			regexp "(\\w*)${versionType}(\\d*)" $archivingPolicy m permission numberOfMonths
			if [string equal {deny} $permission] {
# deny
				if [string equal {} $numberOfMonths] {
# no embargo
					set secondaryDate [list $string {}]	;# deny
				} else {
					set embargoFinalDate [ComputeEmbargoFinalDate $year $month $numberOfMonths]
					set secondaryDate [list $string $embargoFinalDate]
				}
			} else {
# allow
				set secondaryDate [list $string 1995-08-01]	;# allow
			}
		}
	}
	return $secondaryDate
}

if 0 {
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {allowpublisher allowfinaldraft} publisher {}
# => {deny from all} 1995-08-01
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {allowpublisher allowfinaldraft} publisher 150.163
# => {deny from all and allow from 150.163} 1995-08-01
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {denypublisher allowfinaldraft} publisher {}
# => {deny from all} {}
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {denypublisher allowfinaldraft} publisher 150.163
# => {deny from all and allow from 150.163} {}
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {denypublisher12 allowfinaldraft} publisher {}
# => {deny from all} 2011-03-01
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {denypublisher12 allowfinaldraft} publisher 150.163
# => {deny from all and allow from 150.163} 2011-03-01
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {} publisher 150.163
# => {deny from all and allow from 150.163} {}
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {allowpublisher allowfinaldraft} {} 150.163
# => {deny from all and allow from 150.163} 2010-03-01
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {} {} 150.163
# => {deny from all and allow from 150.163} {}
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {denypublisher12 allowfinaldraft} {} 150.163
# => {deny from all and allow from 150.163} 2011-03-01
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {denypublisher24 denyfinaldraft6} {} 150.163
# => {deny from all and allow from 150.163} 2012-03-01
	ComputeSecondaryDateFromArchivingPolicy 2010 mar. {denypublisher denyfinaldraft6} {} 150.163
# => {deny from all and allow from 150.163} {}
}

# ComputeSecondaryDateFromArchivingPolicy - end
# ----------------------------------------------------------------------
# ComputeEmbargoFinalDate
# use in ComputeSecondaryDateFromArchivingPolicy only

proc ComputeEmbargoFinalDate {year month numberOfMonths} {
	array set monthArray {jan. 1 feb. 2 mar. 3 apr. 4 may 5 june 6 july 7 aug. 8 sep. 9 oct. 10 nov. 11 dec. 12}
	array set monthArray {jan. 1 fev. 2 mar. 3 abr. 4 maio 5 jun. 6 jul. 7 ago. 8 set. 9 out. 10 nov. 11 dez. 12}
	array set monthArray {unknown 12}	;# added by GJFB on 2014-08-13 for unknown month
	set lowerCaseMonth [string range [string tolower $month] 0 2].	;# Sept. - Oct. -> sep.
#	if ![info exists monthArray($lowerCaseMonth)] {return}	;# month syntax error - commented by GJFB on 2014-08-13
	if ![info exists monthArray($lowerCaseMonth)] {set lowerCaseMonth unknown}	;# added by GJFB on 2014-08-13 for unknown month
	set publicationDate [expr $year * 12 + $monthArray($lowerCaseMonth)]
	set embargoFinalDateInMonthUnit [expr $numberOfMonths + $publicationDate]
	set embargoFinalDate [expr $embargoFinalDateInMonthUnit / 12]-[format %02i [expr $embargoFinalDateInMonthUnit % 12]]-01
	return $embargoFinalDate
}

# ComputeEmbargoFinalDate - end
# ----------------------------------------------------------------------
# ComputeReadPermissionFromSecondaryDate
# used in UpdateReadPermissionFromSecondaryDate and Submit (cgi/submit.tcl) only

# secondaryDate value must be a list of the form: {{string} {yyyy-mm-dd} {string} {yyyy-mm-dd} ...}
# the list must have an even number of elements
# examples:
# {deny from all} {2008-10-01}
# means to deny from all until 2008-10-01 (included) and
# then to allow from all 
# {deny from all} {2008-10-01} {150.163} {2009-07-31}
# {deny from all} {2008-10-01} {deny from all and allow from 150.163} {2009-07-31}
# means to deny from all until 2008-10-01 (included) and 
# then to allow from 150.163 until 2009-07-31 (included) and
# then to allow from all
# readPermission value is the current read permission
# example:
# deny from all and allow from 150.163.2.174 and allow from 150.163.68 and allow from 192.168.1.100 and allow from 192.168.1.101
# example: 150.163
# returns {} when no changes is possible or required and the new permission otherwise

if 0 {
	ComputeReadPermissionFromSecondaryDate {{deny from all and allow from 150.163} 2011-03-01} {}
# => {} (after 2011-03-01)
	ComputeReadPermissionFromSecondaryDate {{deny from all and allow from 150.163} 2013-03-01} {}
# => deny from all and allow from 150.163 (before 2013-03-01)
	ComputeReadPermissionFromSecondaryDate {{deny from all} 2013-03-01} {}
# => deny from all (before 2013-03-01)
	ComputeReadPermissionFromSecondaryDate {{deny from all and allow from 150.163} {}} {}
# => deny from all and allow from 150.163
	ComputeReadPermissionFromSecondaryDate {{deny from all and allow from 150.163} {}} {deny from all and allow from 150.163}
# => {}
}

proc ComputeReadPermissionFromSecondaryDate {secondaryDate readPermission} {
	
	if [string equal {} $secondaryDate] {return}	;# empty secondary date - leave the read permission as it is
	if [expr [llength $secondaryDate] % 2] {return}	;# odd number of elements
	set todayDate [clock format [clock seconds] -format "%Y-%m-%d"]	;# ISO8601
	set flag 1	;# allow
	foreach {string date} $secondaryDate {
		if [string equal {} $date] {
			if [string equal {allow from all} $readPermission] {break}	;# nothing to do - added  by GJFB on 2017-02-07 to avoid "allow from all" be changed in "deny from all" when a jornal article have no known issn or no archiving policy
			set flag 0	;# deny
			break
		}
		if ![regexp {\d{4,}-\d{2}-\d{2}} $date] {return}	;# not ISO8601
		if {[string compare $todayDate $date] == 1} {continue}	;# date is a past date
# embargo period
		set flag 0	;# deny
		break
	}
	if $flag {
# secondary date is obsolete
# allow
		if [string equal {} $readPermission] {return}	;# nothing to do
		if [string equal {allow from all} $readPermission] {return}	;# nothing to do
		set permission {allow from all}	;# doesn't close permission and remote permission
#		set permission {}	;# closes permission and remote permission
	} else {
# deny
		set ipList [ExtractIPList $string]
		set ipList2 [ExtractIPList $readPermission]
#		if {[regexp {^deny from all} $readPermission] && [string equal $ipList $ipList2]} {return}	;# nothing to do - commented by GJFB on 2012-11-21 - \s* is necessary in some cases
		if {[regexp {^\s*deny from all} $readPermission] && [string equal $ipList $ipList2]} {return}	;# nothing to do
		if [string equal {} $ipList] {
			set permission "deny from all"
		} else {
			set permission "deny from all and allow from $ipList"
		}
#			if [string equal $permission $readPermission] {return}	;# nothing to do
	}
	return $permission
}

# ComputeReadPermissionFromSecondaryDate - end
# ----------------------------------------------------------------------
# SynchronizeRepository
# repName value is the name of the repository to be synchronized
# if the repository in the current local collection contains a copy then
# it is synchronized with the remote repository containing the original

proc SynchronizeRepository {repName} {
# used with cgi-script
#	global localSite	;# doesn´t work with virtual host (e.g., mtc-m21b.sid.inpe.br:80)
	global homePath
	global loCoInRep
	global serverAddressWithIP	;# needed for virtual host (e.g., mtc-m21b.sid.inpe.br 802 - 150.163.34.240 802)

# metadataRep
	set metadataRepName [Execute $serverAddressWithIP [list FindMetadataRep $repName]]
	if ![Execute $serverAddressWithIP [list GetDocumentState $repName]] {
# the document is a copy
		set localMetadataLastUpdate [Execute $serverAddressWithIP [list GetVersionStamp $metadataRepName]]
# puts $localMetadataLastUpdate
#		set remoteSite [FindSiteContainingTheOriginal2 $repName]	;# needs loBiMiRep - returns ip (default)
## puts --$remoteSite--
## => --150.163.34.248 806-- (virtual host)
		set remoteSite [FindSiteContainingTheOriginal2 $repName 0]	;# needs loBiMiRep - returns virtual host domain
# puts --$remoteSite--
# => --mtc-m16d.sid.inpe.br 806-- (virtual host)
# puts --[Execute $remoteSite [list DownloadFileExists $repName] 0]--
		if {$remoteSite == {}} {return}	;# site not found - synchronization impossible 
		set remoteMetadataLastUpdate [Execute $remoteSite [list GetVersionStamp $metadataRepName]]
		if [string equal $localMetadataLastUpdate $remoteMetadataLastUpdate] {return}	;# synchronization already done
# puts {the importation is necessary}
		Load $homePath/col/$loCoInRep/auxdoc/xxx data binary
		set data [UnShift $data]
		set administratorCodedPassword [lindex $data end]
		WaitQueue
# SUBMIT
		set message [Execute $serverAddressWithIP [list ImportRepository [ReturnHTTPHost $remoteSite] $repName $administratorCodedPassword]]	;# deletes download/doc.zip whenever the state value contains the word Modified (see ComputeVersionState)
		LeaveQueue
		if ![string equal {} $message] {
			set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] SynchronizeRepository:\nrepository $repName not imported from $remoteSite:\n$message\n"
# puts $log
			Store log $homePath/@errorLog auto 0 a
		}
	}
}

# SynchronizeRepository - end
# ----------------------------------------------------------------------
# DropTrailingEmptyItems
# drop trailing empty items
# a {} c {} -> a {} c
# used in 

proc DropTrailingEmptyItems {inputList} {
	set outputList {}
	set flag 1
	for {set i [expr [llength $inputList] - 1]} {$i >= 0} {incr i -1} {
		set item [lindex $inputList $i]
		if {$flag && [string equal {} $item]} {continue}
		set outputList [concat [list $item] $outputList]
		set flag 0
	}
	return $outputList
}
# Drop trailing empty items - end
# ----------------------------------------------------------------------
# ComputeFieldValueList
# used by MountHTMLPage, DisplayShortCut and DisplayMultipleSearch
# item examples of siteList:
# banon-pc2.dpi.inpe.br:1905 (old usage)
# {banon-pc2.dpi.inpe.br 19050}
# banon-pc2.dpi.inpe.br:80 (old usage)
# {banon-pc2.dpi.inpe.br 800}
# {150.163.2.174 800}
# {sbsr.sid.inpe.br 802}
# test value is 0 or 1
# 1 means to leave the duplicates (and do no sorting)
# 0 means to drop the duplicates (using -unique)
# siteInfoFlag value is 0 or 1
# 1 means to add the site information to the field value, ex: Advances_in_Space_Research {banon-pc3 800}
# 0 means to do not add the site information, ex: Advances_in_Space_Research

# subsetOfGroups value is a list of groups, example: {DPI DSR}
# used with first group, for example, searching for firstgr DPI returns the entries
# for which DPI is the first group among the groups DPI and DSR
# regexp matching
# not in use and not tested with ComputeFieldValueList

# subsetOfGroups2 value is empty or a list of group values, for example: {DPI DSR} or OBT
# used to find the first author which belongs to a given group or subset of groups
# when subsetOfGroups2 is not empty, the fieldNameList must be at most: {firstauthor firsteditor}

# subsetOfGroups2 value is empty or a pair of list of group values, for example:
# {} {OBT SRE}
# {SRE YYY} {AMZ-OBT DGI-OBT DPI-OBT DSR-OBT OBT-OBT}
# when subsetOfGroups2 is not empty, the fieldNameList must be at most: {firstauthor firsteditor}

# when the first list is empty like in {} {OBT SRE}
# just the first author which belongs to the group or subset of groups given in the second list is selected

# no exemplo:
# 1 Roig, Carla de Almeida
# 2 Monteiro, Antônio Miguel Vieira
# 3 Feitosa, Flávia da Fonseca
# 4 Alves, Diogenes Salas
# 1 CST-CST-SPG-INPE-MCTI-GOV-BR
# 2 DPI-OBT-INPE-MCTI-GOV-BR
# 3 CST-CST-INPE-MCTI-GOV-BR
# 4 DPI-OBT-INPE-MCTI-GOV-BR

# Monteiro, Antônio Miguel Vieira is selected as first author (from OBT)

# when the first list is nonempty like in {SRE YYY} {AMZ-OBT DGI-OBT DPI-OBT DSR-OBT OBT-OBT}
# the group values in first list are used to match (regexp matching) groups that must be discarted
# when looking for the first group
# the group values in second list are used to match (regexp matching) groups that must be considered
# when looking for the first group
# if the first group is encountered,

# no exemplo:
# Monteiro, Antônio Miguel Vieira is selected as first author (from DPI-OBT) - the current metadata repository is associated to this author
# Alves, Diogenes Salas is selected as author (but not as first author) (from DPI-OBT) - the current metadata repository is NOT associated to this author

# regexp matching

# firstCreatorFlag value is 0 or 1
# 1 means to find the first creator whose group belongs to subsetOfGroups2

# simple example:
# ComputeFieldValueList {col Voyage France} theme yes yes {{gjfb 19050} {marte.sid.inpe.br 800} {bibdigital.sid.inpe.br 800} {marte3.sid.inpe.br 804}}
# => Montauban Toulouse Carcassonne Lourdes Albi {Maison de vovó Michelle} Paris Paris Paris Paris Paris

proc ComputeFieldValueList {
	searchExpression fieldNameList accent case siteList {test 0}
	{siteInfoFlag 0} {subsetOfGroups {}} {subsetOfGroups2 {}} {firstCreatorFlag 0}
} {
	global env
	global homePath
	global currentRep
	global siteMetadataRepList	;# set in MultipleSubmit 
	global numberOfSatisfiedQueries	;# set in MultipleSubmit
	global numberOfActiveSites	;# used in CreateTclPage
	global cgi
	global optionTable2	;# set in Submit (used when making table of contents)

#  safeFlag must be set to 0 in CreateTclPage in order to use the Store command

# set xxx [CallTrace]
# Store xxx C:/tmp/bbb.txt binary 0 a
# =>
# call stack
# 3: ComputeFieldValueList {col Voyage France} theme yes yes {{gjfb 19050} {marte.sid.inpe.br 800} {bibdigital.sid.inpe.br 800} {marte3.sid.inpe.br 804}}
# 2: MountHTMLPage urlib.net/www/2013/06.21.00.03 {Archival Unit} {Voyage en France en 2012} File {Banon, G. J. F. & Banon, G. P. R.} 2012 J8LNKB5R7W/3EB9F8L dpi.inpe.br/banon/1999/06.19.17.00 {{col Voyage France} theme} 1 image {sort date.key frozencontents yes} 0 {} {}
# 1: DisplayDocContent
# call stack - end
 
	if {[lsearch $fieldNameList {type}] != -1} {
		if [info exists {optionTable2(Conference Proceedings,%9)}] {
			set themeList {}
			foreach item $optionTable2(Conference Proceedings,%9) {
				set theme [lindex $item 1]
				if ![string equal {} $theme] {
					lappend themeList $theme
				}
			}
			return $themeList
		}
	}

	if {[lsearch $fieldNameList {tertiarytype}] != -1} {
		if [info exists {optionTable2(Conference Proceedings,%tertiarytype)}] {
			set tertiaryTypeList {}
			foreach item $optionTable2(Conference Proceedings,%@tertiarytype) {
				set tertiaryType [lindex $item 1]
				if ![string equal {} $tertiaryType] {
					lappend tertiaryTypeList $tertiaryType
				}
			}
			return $tertiaryTypeList
		}
	}

#	array set environment [array get env]	;# used in MultipleSubmit when siteList == {}

# mirrorRep
	set mirrorRep $currentRep	;# not used in GetMetadataRepositories

#	if ![info exists siteMetadataRepList] {
# the above if could avoid a new search when the search expression remains unchanged
# but it leads, for example, to wrong results when calling DisplayMultipleSearch
# more than once in the same tcl page with different search expressions

		if ![info exists cgi(codedpassword1)] {set cgi(codedpassword1) {}}
if 1 {
		set query [list list GetMetadataRepositories $mirrorRep 1 $searchExpression $accent $case 0 {} repArray $cgi(codedpassword1)]
#		set query [list list GetMetadataRepositories $mirrorRep 4 $searchExpression $accent $case 0 metadatalastupdate repArray $cgi(codedpassword1) key 0 {} 0]	;# doesn't work - returns empty - model of search used in CreateOutput
} else {
# not in use and not tested
		set query [list list GetMetadataRepositories $mirrorRep 1 $searchExpression $accent $case \
		0 {} repArray $cgi(codedpassword1) \
		pages 0 $subsetOfGroups]
}

# MULTIPLE SUBMIT
		set siteMetadataRepList {}
		MultipleSubmit {} $query siteMetadataRepList 0 $siteList
#	}
	set numberOfActiveSites $numberOfSatisfiedQueries

# Store siteMetadataRepList C:/tmp/bbb.txt binary 0 a	;# may content an error message

	set firstListFromSubsetOfGroups2 [lindex $subsetOfGroups2 0]
	set secondListFromSubsetOfGroups2 [lindex $subsetOfGroups2 end]
# set xxx --$firstListFromSubsetOfGroups2--
# Store xxx C:/tmp/bbb.txt binary 0 a
	set fieldValueList {}
	foreach siteMetadataRep $siteMetadataRepList {
		foreach {site rep-i} $siteMetadataRep {break}
		if $firstCreatorFlag {
			set referenceType [Execute $site [list GetFieldValue ${rep-i} referencetype]]
			set groupList [Execute $site [list GetFieldValue ${rep-i} group]]
# metadataRep
			if ![regexp {(.*)-0$} ${rep-i} m metadataRep] {continue}
		}
# Store groupList C:/tmp/bbb.txt binary 0 a
# {} DPI-OBT-INPE-MCTI-GOV-BR
# DPI-OBT-INPE-MCT-BR
# Store fieldNameList C:/tmp/bbb.txt binary 0 a
# author editor

		foreach fieldName $fieldNameList {
#			if [regexp {^firstauthor|^author|^editor|^programmer|^committee} $fieldName] #
			if [regexp {^firstauthor|^firsteditor|^firstprogrammer|^firstcommittee|^author|^editor|^programmer|^committee} $fieldName] {
# see CreateRepArray
				set fieldValueList2 [Execute $site [list GetFieldValue ${rep-i} $fieldName]]
				if $firstCreatorFlag {
					if [string equal {} $fieldValueList2] {continue}	;# there are no authors in Edited Book, creator (%A) is editor
					if {[string equal {editor} $fieldName] && [regexp {^(Book Section|Conference Proceedings)$} $referenceType]} {continue}	;# there might be editors in Book Section and Conference Proceedings but they are no creator (%A)
					if [string equal {} $firstListFromSubsetOfGroups2] {
# ex: $subsetOfGroups2 == {} {OBT SRE}
# find the first creator whose group belongs to secondListFromSubsetOfGroups2
						set firstCreatorFoundFlag 0	;# not found
						foreach fieldValue $fieldValueList2 group $groupList {
							foreach group2 $secondListFromSubsetOfGroups2 {
# REGEXP MATCHING
# set xxx OK
# Store xxx C:/tmp/bbb.txt binary 0 a
								if [regexp $group2 $group] {
# group2 == OBT and group == DPI-OBT-INPE-MTCI-GOV-BR
									set name [string trim $fieldValue]
									regsub {,$} $name {} name	;# added by GJFB on 2014-07-01 - drop trailing comma - Banon, Gerald Jean Francis,$ -> Banon, Gerald Jean Francis
									regsub -all { } $name {_} name
									set fieldValue _$name	;# added by GJFB on 2014-07-01
									set fieldValue [encoding convertfrom utf-8 $fieldValue]	;# solves the accent problem im mtc-m21b when displaying author names registered in plutao) - added by GJFB on 2014-10-01 
#									lappend fieldValueList $fieldValue
									lappend firstCreatorArray($fieldValue) $metadataRep
									set firstCreatorFoundFlag 1
									break
								}
								if $firstCreatorFoundFlag {break}
							}
							if $firstCreatorFoundFlag {break}
						}
					} else {
# ex: $subsetOfGroups2 == {SRE YYY} {AMZ-OBT DGI-OBT DPI-OBT DSR-OBT OBT-OBT}
						set firstCreatorFoundFlag 0	;# not found
						foreach fieldValue $fieldValueList2 group $groupList {
							set discardFlag 0	;# don't discard 
							foreach group2 $firstListFromSubsetOfGroups2 {
# REGEXP MATCHING
								if {[string equal {} $group] || [regexp $group2 $group]} {set discardFlag 1; break}
							}
							if $discardFlag {continue}
							foreach group2 $secondListFromSubsetOfGroups2 {
# REGEXP MATCHING
								if [regexp $group2 $group] {
# group2 == DPI-OBT and group == DPI-OBT-INPE-MTCI-GOV-BR
									set name [string trim $fieldValue]
									regsub {,$} $name {} name	;# added by GJFB on 2014-07-01 - drop trailing comma - Banon, Gerald Jean Francis,$ -> Banon, Gerald Jean Francis
									regsub -all { } $name {_} name
									set fieldValue _$name	;# added by GJFB on 2014-07-01
									set fieldValue [encoding convertfrom utf-8 $fieldValue]	;# solves the accent problem im mtc-m21b when displaying author names registered in plutao) - added by GJFB on 2014-10-01
									if $firstCreatorFoundFlag {
										if ![info exists firstCreatorArray($fieldValue)] {
											set firstCreatorArray($fieldValue) {}
										}
									} else {
										lappend firstCreatorArray($fieldValue) $metadataRep
									}
									break
								}
							}
							set firstCreatorFoundFlag 1	;# found
						}
					}
				} else {
					foreach fieldValue $fieldValueList2 {
#						regsub -all { } $fieldValue {_} fieldValue
						set name [string trim $fieldValue]
						regsub {,$} $name {} name	;# added by GJFB on 2014-07-01 - drop trailing comma - Banon, Gerald Jean Francis,$ -> Banon, Gerald Jean Francis
						regsub -all { } $name {_} name
						set fieldValue _$name	;# added by GJFB on 2014-07-01
						lappend fieldValueList $fieldValue
					}
				}
#			elseif [regexp {^reporter|^cartographer|^base|^translator|^serieseditor|^source|^group|^affiliation} $fieldName]
			} elseif {[lsearch -exact $env(MULI_LIST) $fieldName] != -1} {
# multiple line fields
#				set fieldValueList [concat $fieldValueList [Execute $site [list GetFieldValue ${rep-i} $fieldName]]]
				set fieldValueList2 [Execute $site [list GetFieldValue ${rep-i} $fieldName]]
				foreach fieldValue $fieldValueList2 {
					if ![string equal {} $fieldValue] {
						lappend fieldValueList $fieldValue
					}
				}
			} elseif {[regexp {^keywords} $fieldName]} {
				set keywords [Execute $site [list GetFieldValue ${rep-i} $fieldName]]
				regsub {\.$} $keywords {} keywords
				foreach word [split $keywords ,] {
					regsub -all {<|>} $word {} word
					lappend fieldValueList [string trim $word]
				}
#			# elseif [regexp {^journal|^conferencename} $fieldName] #	;# commented by GJFB on 2021-07-18
			} elseif {[regexp {^(journal|conferencename|course)$} $fieldName]} {	;# added by GJFB on 2021-07-18 to include the course option in Administrator page for unifying field values
				set fieldValue [Execute $site [list GetFieldValue ${rep-i} $fieldName]]
				if ![string equal {} $fieldValue] {
					set fieldValue [string trim $fieldValue]	;# added by GJFB on 2014-07-07 to prevent adding extra heading and trailing _ 
					regsub -all { } $fieldValue {_} fieldValue
					if $siteInfoFlag {
						if [regexp {^course$} $fieldName] {
							lappend fieldValueList [list $fieldValue $site]	;# added by GJFB on 2021-07-18
						} else {
#							lappend fieldValueList [list $fieldValue $site]	;# Advances_in_Space_Research {banon-pc3 800}
							lappend fieldValueList [list _$fieldValue $site]	;# _Advances_in_Space_Research {banon-pc3 800} - added by GJFB on 2014-07-01 - _ used in Administrator page for unifying field values and Administrator page for setting the attribute values of a field
						}
					} else {
						lappend fieldValueList $fieldValue
					}
				}
			} else {
#				set fieldValue [join [Execute $site [list GetFieldValue ${rep-i} $fieldName]]]	;# join is for firstauthor (for example)
				set fieldValue [Execute $site [list GetFieldValue ${rep-i} $fieldName]]
				if ![string equal {} $fieldValue] {
					lappend fieldValueList $fieldValue
				}
			}
		}
	}
# Store fieldValueList C:/tmp/bbb.txt binary 0 a
# =>
# Montauban Toulouse Carcassonne Lourdes Albi {Maison de vovó Michelle} Paris Paris Paris Paris Paris

#	return [lsort -unique -dictionary $fieldValueList]
#	return [lsort -unique -command CompareDiscardingAccentCase $fieldValueList]
	if $test {
		return [encoding convertfrom utf-8 $fieldValueList]	;# solves the accent problem (e.g., with plutao)	;# added by GJFB on 2013-02-18 because of the unifying and setting applications
	} else {
		if $firstCreatorFlag {
			set firstCreatorList [array get firstCreatorArray]
 Store firstCreatorList C:/tmp/bbb.txt binary 0 a
# => _Eras,_Eduardo_Rohde urlib.net/www/2012/02.06.20.03.37
# => _Galvíncio,_Josiclêda_Domiciano {} _Eras,_Eduardo_Rohde urlib.net/www/2012/02.06.20.03.37
			return $firstCreatorList
		} else {
			return [lsort -unique -command CompareDiscardingAccentCase [encoding convertfrom utf-8 $fieldValueList]]	;# solves the accent problem (e.g., with plutao)
		}
	} 
}

# ComputeFieldValueList - end
# ----------------------------------------------------------------------
# CompareDiscardingAccentCase
# used by ComputeFieldValueList only
# accents are removed before comparison using accentTable2

proc CompareDiscardingAccentCase {a b} {
	upvar #0 accentTable2 accentTable2
	foreach letter [split $a {}] {
		if [info exists accentTable2($letter)] {set letter $accentTable2($letter)}
		lappend a2 [string toupper $letter]
	}
	foreach letter [split $b {}] {
		if [info exists accentTable2($letter)] {set letter $accentTable2($letter)}
		lappend b2 [string toupper $letter]
	}
	return [string compare $a2 $b2]
}

# CompareDiscardingAccentCase - end
# ----------------------------------------------------------------------
# AddNumberOfDuplicates
# used in Script (dpi.inpe.br/banon-pc2@1905/2006/02.16.12.09/doc/cgi/script.tcl) only
# similar code in DisplayMultipleSearch (utilities3.tcl) - see Mount fieldValueList2
# inputList must be a sorted list

proc AddNumberOfDuplicates {inputList} {
	set outputList {}
	set i 0
	if [info exists previousItem] {unset previousItem}
	foreach item $inputList {
		if [info exists previousItem] {
			if [string equal $previousItem $item] {
				incr i
			} else {
				lappend outputList [list $i $previousItem]
				set previousItem $item
				set i 1
			}
		} else {
			set previousItem $item
			set i 1
		}
	}
	if ![string equal {} $inputList] {
		lappend outputList [list $i $item]
	}
# puts --$outputList--
	return $outputList
}

if 0 {
AddNumberOfDuplicates {a b b c d e e e}
# => {1 a} {2 b} {1 c} {1 d} {3 e}
}		

# AddNumberOfDuplicates - end
# ----------------------------------------------------------------------
# AcknowledgeArchive
# used in col/urlib.net/www/2014/03.16.03.40/doc/cgi/script.tcl only (Archive service)

proc AcknowledgeArchive {urlPropertyList} {
#	global env
	global serverAddress	;# added by GJFB on 2015-02-18 - now AcknowledgeArchive is called from the local site itself
	
	array set urlPropertyArray $urlPropertyList

# set xxx [CallTrace]
# Store xxx C:/tmp/bbb.txt auto 0 a
# Store xxx /mnt/dados1/URLib21c/bbb.txt auto 0 a
# =>
# call stack
# 2: AcknowledgeArchive {clientinformation.citingitem urlib.net/www/2023/06.03.21.17 urlkey 1750047257411-7669667352537722 ibi {rep sid.inpe.br/mtc-m21c/2021/03.18.18.13 ibip 8JMKD3MGP3W34R/44C25PS} state Original contenttype Data url.persistent http://mtc-m21c.sid.inpe.br:80/ibi/8JMKD3MGP3W34R/44C25PS?ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17&linktype=relative clientinformation.ipaddress 200.207.175.71 url http://mtc-m21c.sid.inpe.br/col/sid.inpe.br/mtc-m21c/2021/03.18.18.13/doc/A1.Apres.Rede.IBI.p.NIC.br.Abr.21.V.15reviewed.pdf?linktype=relative&ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17}
# 1: Script
# call stack - end

## state	
#	set state $urlPropertyArray(state)
#	if ![string equal {Deleted} $state] {
	
# urlKey
#		set urlKey $urlPropertyArray(urlkey)	;# commented by GJFB on 2025-06-15
#		if [CheckSession $urlKey urlkey] #	;# commented by GJFB on 2025-06-15
# contentType
			set contentType $urlPropertyArray(contenttype)
			if [string equal {Data} $contentType] {
# ibi
				set ibi $urlPropertyArray(ibi)	;# with the URLib platform urlPropertyArray(ibi) always exists
				array set ibiArray $ibi
				set URParts [file split $ibiArray(rep)]
				set documentServerAddress $serverAddress	;# if needed CountOneClick uses FindSiteContainingTheOriginal2
				set localURLibClientSocketId [eval "StartCommunication $documentServerAddress"]
#				Submit $localURLibClientSocketId [list PostponeOneClickCount $URParts]
				set clientIPAddress $urlPropertyArray(clientinformation.ipaddress)
				ConditionalSet citingItem urlPropertyArray(clientinformation.citingitem) {}	;# added by GJFB on 2024-01-04 to turn persistent hyperlinks robust
#				Submit $localURLibClientSocketId [list PostponeOneClickCount $URParts $clientIPAddress]	;# commented by GJFB on 2024-01-04
				Submit $localURLibClientSocketId [list PostponeOneClickCount $URParts $clientIPAddress $citingItem]	;# added by GJFB on 2024-01-04
				close $localURLibClientSocketId
			}
#			CloseSession $urlKey urlkey	;# commented by GJFB on 2024-08-17 - now there is no more urlkey open session (see GetURLPropertyList)
#		#
#	}
}

# AcknowledgeArchive - end
# ----------------------------------------------------------------------
# ConvertSimpleListToListForArray
# example:
# ConvertSimpleListToListForArray {1 2} {a b}
# => 1 a 2 b
## used in ConvertListToListForArray, InformURLibSystem and Script (urlib.net/www/2014/03.16.03.40) only
# used in InformURLibSystem and Script (urlib.net/www/2014/03.16.03.40) only

proc ConvertSimpleListToListForArray {entryList simpleList} {
	foreach name $entryList value $simpleList {
		lappend listForArray $name $value
	}
	return $listForArray
}

# ConvertSimpleListToListForArray - end
# ----------------------------------------------------------------------
# ConvertListForArrayToSimpleList
# example:
# ConvertListForArrayToSimpleList {1 2} {2 b 1 a}
# => a b
# ConvertListForArrayToSimpleList {1 2} {2 b 3 c 1 a}
# => a b
# ConvertListForArrayToSimpleList {1 2 3} {2 b 1 a 3 c}
# => a b c
# ConvertListForArrayToSimpleList {1 2 3} {2 b 1 a}
# => a b

# used in Script (urlib.net/www/2014/03.22.01.53) only

proc ConvertListForArrayToSimpleList {entryList listForArray} {
	array set array $listForArray
	foreach entry $entryList {
		if ![info exists array($entry)] {continue}
		lappend simpleList $array($entry)
	}
	return $simpleList
}

# ConvertListForArrayToSimpleList - end
# ----------------------------------------------------------------------
# GetClientIP
# used by CreateMirror, Archive, ResolveIBI, Get- and Get only

proc GetClientIP {} {
	global env
	
	if [info exists env(HTTP_X_FORWARDED_FOR)] {
#		return [lindex [split $env(HTTP_X_FORWARDED_FOR) ,] 0] 
		return [split $env(HTTP_X_FORWARDED_FOR) ,] 
	} elseif {[info exists env(REMOTE_ADDR)]} { 
		return $env(REMOTE_ADDR) 
#	} elseif {[info exists env(HTTP_CLIENT_IP)]} #
#		return $env(HTTP_CLIENT_IP) 
#	# 
	return {}
}

# GetClientIP - end
# ----------------------------------------------------------------------
# CreateListOfurlPropertiesFromAgencies
# used only by www.urlib.net resolver in Get- and Get
# similar to the code in FindURLPropertyList2

proc CreateListOfurlPropertiesFromAgencies {parsedIBIURL selectedLanguageFromMirror languageRep1 languageRep2 localSite} {
#	global env
	global homePath	;# set in Get- and Get
	global loCoInRep	;# set in Get- and Ge
	
	package require http
	
#	source $homePath/col/dpi.inpe.br/banon/2004/02.16.09.29/auxdoc/agencyHTTPHostList.tcl	;# set agencyHTTPHostList
	source $homePath/col/$loCoInRep/auxdoc/agencyHTTPHostList.tcl	;# set agencyHTTPHostList
# example:	
#	set agencyHTTPHostList {
#		www.urlib.net
#		licuri.ibict.br
#		sibgrapi.sid.inpe.br
#		gjfb0520.sid.inpe.br
#	}
	
	array set ibiURLArray $parsedIBIURL	
# ibi		
#	regsub -all {^/|^/rep-?/|[:!+].*} $env(REQUEST_URI) {} ibi
	set ibi $ibiURLArray(parsedibiurl.ibi)
# verbList
	set verbList $ibiURLArray(parsedibiurl.verblist)
# filePath
	set filePath /$ibiURLArray(parsedibiurl.filepath)
	if [string equal {/} $filePath] {set filePath {}}

# extraPair2
	if [info exists ibiURLArray(parsedibiurl.metadatafieldnamelist)] {
## used with Get (new code)
		set extraPair2 &ibiurl.metadatafieldnamelist=$ibiURLArray(parsedibiurl.metadatafieldnamelist)
	} else {
## used with Get-
		set extraPair2 {}
	}

# www.urlib.net resolver running
# >>> step 1 (input) of the agency structure communication scheme (www.urlib.net resolver -> agency resolver)
# http://gjfb.home:1905/rep-/J8LNKB5R7W/3N8UTK5?ibiurl.returntype=urlpropertylist
# http://gjfb.home:1905/rep-/urlib.net/www/2013/06.24.20.00?ibiurl.returntype=urlpropertylist

	set messageList {}
# FOREACH
	foreach agencyHTTPHost $agencyHTTPHostList {
		if [string equal {www.urlib.net} $agencyHTTPHost] {set extraPair1 &ibiurl.requiredsite=www.urlib.net} else {set extraPair1 {}}
# http://www.urlib.net/J8LNKB5R7W/3CP2248?ibiurl.returntype=urlpropertylist&ibiurl.requiredsite=www.urlib.net
# http://www.urlib.net/8JMKD3MGPAW34P/3NERTH2?ibiurl.returntype=urlpropertylist&ibiurl.requiredsite=www.urlib.net
# http://gjfb0520.sid.inpe.br/8JMKD3MGPAW34P/3NERTH2?ibiurl.returntype=urlpropertylist
		
#		set recipientAddress $agencyHTTPHost/$ibi$filePath ;# commented by GJFB on 2017-04-05
		set recipientAddress $agencyHTTPHost/rep-/$ibi$filePath ;# added by GJFB on 2017-04-05 - rep- needed to allow from all when environmentArray(spUseUserAuthentication) is 1
		set messageContent ibiurl.verblist=$verbList&ibiurl.returntype=urlpropertylist$extraPair1$extraPair2
		lappend messageList [list HTTP $recipientAddress $messageContent]
#		lappend messageList [list HTTP $agencyHTTPHost $recipientAddress $messageContent]
	}

if 0 {
# old code still working - uses CreateListOfurlProperties	
# commented by GJFB on 2017-12-26
	set numberOfResponses 0
	set numberOfSites [llength $agencyHTTPHostList]	
	set tokenList {}
	
# FOREACH
	foreach agencyHTTPHost $agencyHTTPHostList {
		if [string equal {www.urlib.net} $agencyHTTPHost] {set extraPair1 &ibiurl.requiredsite=www.urlib.net} else {set extraPair1 {}}
# http://www.urlib.net/J8LNKB5R7W/3CP2248?ibiurl.returntype=urlpropertylist&ibiurl.requiredsite=www.urlib.net
# http://www.urlib.net/8JMKD3MGPAW34P/3NERTH2?ibiurl.returntype=urlpropertylist&ibiurl.requiredsite=www.urlib.net
# http://gjfb0520.sid.inpe.br/8JMKD3MGPAW34P/3NERTH2?ibiurl.returntype=urlpropertylist
#		if [catch {http::geturl [ConvertURLToHexadecimal http://$agencyHTTPHost/$ibi$filePath?ibiurl.returntype=urlpropertylist$extraPair1$extraPair2 1] -command CreateListOfurlProperties -timeout 3000} token] # ;# commented by GJFB on 2017-04-05
#		if [catch {http::geturl [ConvertURLToHexadecimal http://$agencyHTTPHost/rep-/$ibi$filePath?ibiurl.returntype=urlpropertylist$extraPair1$extraPair2 1] -command CreateListOfurlProperties -timeout 3000} token] # ;# added by GJFB on 2017-04-05 - rep- needed to allow from all when environmentArray(spUseUserAuthentication) is 1
		if [catch {http::geturl [ConvertURLToHexadecimal http://$agencyHTTPHost/rep-/$ibi$filePath?ibiurl.verblist=$verbList&ibiurl.returntype=urlpropertylist$extraPair1$extraPair2 1] -command CreateListOfurlProperties -timeout 3000} token] { ;# added by GJFB on 2017-04-05 - rep- needed to allow from all when environmentArray(spUseUserAuthentication) is 1
			incr numberOfResponses
		} else {
			lappend tokenList $token
		}
	}
	
	set agencyFailureFlag [expr $numberOfResponses > 0]	;# 1 means that at list one agency connection fails 
	
	set flag 1	;# enable while
	set time 0
# puts $tokenList
	while {$flag} {
		set xWaitQueue 0; after 100 {set xWaitQueue 1}; vwait xWaitQueue
		incr time 100
		foreach token $tokenList {
			if [info exists ${token}(found)] {
# puts ($token)	;# nice puts
# puts [set ${token}(found)]	;# nice puts
				if {[set ${token}(found)] == 1} {set flag 0; break}	;# the required item has been found
				if [set ${token}(found)] {
					incr numberOfResponses
					set ${token}(found) 0	;# set to 0 in order to incr numberOfResponses only once while the while is running
					if {$numberOfResponses == $numberOfSites} {set flag 0; break}	;# all the sites have been processed
				}
			}
		}
		if {$time > 7000} {set flag 0}	;# time-out (3s + 4s) - 3s is timeout for http::geturl - 4s is to let Apache server respond
	}
	
# Create listOfurlProperties
	set listOfurlProperties {}
	foreach token $tokenList {
# puts --[http::data $token]--	;# data is empty when status is not ok
# puts [http::status $token]
# puts $xWaitQueue
		if [string equal {ok} [http::status $token]] {
# puts $token
			set urlProperties [string trim [http::data $token]]
# puts --$urlProperties--
			http::cleanup $token
			if [regexp {^<} $urlProperties] {
# urlProperties contains an error message
			} else {
# norm simplification
				lappend listOfurlProperties $urlProperties
			}
		}
	}
# Create listOfurlProperties - end

	if {!$agencyFailureFlag && [string equal {} $listOfurlProperties]} {
# ibi not found
		set callingProcedureName {}
		set contextLanguage $selectedLanguageFromMirror
		DisplayWarningMessage $ibi $callingProcedureName $contextLanguage $languageRep1 $languageRep2 $localSite	;# runs an error command
	}	
} else {
# new code	
# added by GJFB on 2017-12-26
	set agencyStructureFlag 1
	set scanAllArchivesFlag 0
	set listOfurlProperties [CreateResponseList $ibi $messageList $agencyStructureFlag $scanAllArchivesFlag]
}

# Create urlPropertyList2
# www.urlib.net resolver
# >>> step 2 (output) of the agency structure communication scheme (agency resolver -> www.urlib.net resolver)
	set urlPropertyList2 {}	;# nothing found
	foreach urlProperties $listOfurlProperties {
		if ![string equal {} $urlProperties] {
			set urlPropertyList2 $urlProperties	;# something found (first found)
			break
		}
	}
# puts --$urlPropertyList2--
# =>
# archiveaddress gjfb.home:1905 contenttype Data ibi {rep urlib.net/www/2017/01.25.14.02 ibip J8LNKB5R7W/3N8UTK5} ibi.archiveservice {rep dpi.inpe.br/banon/1999/01.09.22.14} ibi.platformsoftware {rep dpi.inpe.br/banon/1998/08.02.08.56} state Original timestamp 2017-02-05T18:15:54Z url http://gjfb.home:1905/createpage.cgi/urlib.net/www/2017/01.25.14.02/doc/carta.tex urlkey 1488002121-5277263374485597
# Create urlPropertyList2 - end

	return $urlPropertyList2
}

# CreateListOfurlPropertiesFromAgencies - end
# ----------------------------------------------------------------------
# CreateListOfurlProperties
# callBack procedure
# used in CreateListOfurlPropertiesFromAgencies only

# not used anymore since 2017-12-26
proc CreateListOfurlProperties {token} {
	upvar #0 $token state
	
	set urlProperties [string trim [http::data $token]]
##	if {[string equal {} $urlProperties] || [regexp {^<.*>$} $urlProperties errorMessage]} #
#	if {[string equal {} $urlProperties] || [regexp {^<} $urlProperties errorMessage]} #
## errorMessage not used (could be a 500 Internal Server Error due to a wrong code)
	if [string equal {} $urlProperties] {
		set state(found) 2; return	;# continue
	} else {
		set state(found) 1; return	;# use the first found (non-empty)
	}
}

# CreateListOfurlProperties - end
# ----------------------------------------------------------------------
# CreateResponseList
# used in FindURLPropertyList2 and CreateListOfurlPropertiesFromAgencies only

proc CreateResponseList {ibi messageList agencyStructureFlag scanAllArchivesFlag {pID {}}} {
	global printFlag	;# set in Get and Get- only
	global localSite	;# set in Get
	global selectedLanguageFromMirror languageRep1 languageRep2	;# set in Get
	
# return	;# testing "Tabela fornecendo os dados para o cálculo dos indicadores Físicos e Operacionais IPUB e IGPUB: ano de 2016" while there is no call to GetURLPropertyList

set storeFlag 0
# set storeFlag 1

if $storeFlag {
 global applicationNameForReverseEngineering applicationRuningTime applicationFileName	;# for reverse engineering only
 global homePath
 if [info exists applicationNameForReverseEngineering] {
	set xxx "$applicationNameForReverseEngineering"
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx "$applicationRuningTime $applicationFileName"
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx [CallTrace]
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx {}
	Store xxx $homePath/bbb.txt auto 0 a
 }
}

if 0 {	
	puts {Content-Type: text/plain}
	puts {}
	puts --$messageList--
# => --{USP {gjfb 19050} {GetURLPropertyList {clientinformation.ipaddress 192.168.0.103 parsedibiurl.filepath vestiges/urlibServicePage1995.pdf parsedibiurl.ibi dpi.inpe.br/banon/1995/08.08.00.00 parsedibiurl.metadatafieldnamelist {mirrorrepository readergroup readpermission title}}}}--
}

	set numberOfResponses 0
	set numberOfSites [llength $messageList]
	set tokenList {}
	if $agencyStructureFlag {	;# added by GJFB on 2019-03-20
		set agencyFailureFlag 0
	}
	
	package require http	;# added by GJFB on 2017-02-22

# FOREACH
	set siteList {}
	set httpMessageList {}
	foreach message $messageList {
# puts $message
		foreach {archiveProtocol recipientAddress messageContent} $message {break}
# archiveProtocol type may be forced in FindURLPropertyList2
		if {[string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol]} {
# USP
			lappend siteList $recipientAddress
			if ![info exists query] {set query "list $messageContent"}
		} else {
# HTTP
			lappend httpMessageList $message
		}
	}	;# end foreach
	
# USP
# Which is the best scenario?
#										does the ibi exist?
#	does all occurences must be found?		yes		no
#	yes										0		0		
#	no										2		2	0
	if [llength $siteList] {
		global listOfibiProperties
		set listOfibiProperties {}
#		MultipleSubmit {} $query listOfibiProperties 0 $siteList
#		MultipleSubmit {} $query listOfibiProperties 2 $siteList
		MultipleSubmit {} $query listOfibiProperties [expr 2*!$scanAllArchivesFlag] $siteList
	}
#	return $listOfibiProperties
# puts "MultipleSubmit {} $query listOfibiProperties [expr 2*!$scanAllArchivesFlag] $siteList"
# => MultipleSubmit {} list GetURLPropertyList {clientinformation.ipaddress 192.168.0.112 parsedibiurl.ibi urlib.net/www/2021/04.27.01.57 parsedibiurl.backgroundlanguage en parsedibiurl.metadatafieldnamelist {booktitle contenttype copyright doi fullname identifier issn language metadatalastupdate metadatarepository mirrorrepository nextedition nexthigherunit parameterlist previousedition readergroup readpermission referencetype repository rightsholder shorttitle size targetfile title username} parsedibiurl.requiredsite {gjfb 19050}} listOfibiProperties 2 {gjfb 19050}
# puts --$listOfibiProperties--
# HTTP
	if [llength $httpMessageList] {
# FOREACH	
		foreach message $httpMessageList {
# puts $message
			foreach {archiveProtocol recipientAddress messageContent} $message {break}
# archiveProtocol type may be forced in FindURLPropertyList2
			if {0 && ([string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol])} {
# USP
				set scenario 0
				set ibiResolutionFlag 1
				set encodingName {}
				set replyListName {}
# set xxx [list RemoteExecute $recipientAddress $messageContent $scenario CreateListOfibiProperties2 {} $pID $ibiResolutionFlag]
# Store xxx C:/tmp/bbb.txt binary 0 a
# catch below is effective for unix only (see RemoteExecute)
				if [catch {RemoteExecute $recipientAddress $messageContent $scenario CreateListOfibiProperties2 $encodingName $pID $ibiResolutionFlag $replyListName} token] {
# host is down
if $storeFlag {
 if [info exists applicationNameForReverseEngineering] {
	set xxx {catch returns 1}
	Store xxx $homePath/bbb.txt auto 0 a
 }
}
					incr numberOfResponses
					if $agencyStructureFlag {	;# added by GJFB on 2019-03-20
						set agencyFailureFlag 1
						break
					}
				} else {
if $storeFlag {
 if [info exists applicationNameForReverseEngineering] {
	set xxx {catch returns 0}
	Store xxx $homePath/bbb.txt auto 0 a
 }
}
if $storeFlag {
 if [info exists applicationNameForReverseEngineering] {
	set xxx $token
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx $recipientAddress
	Store xxx $homePath/bbb.txt auto 0 a
 }
}
					global $token
					lappend tokenList $token
					set ${token}(scanall) $scanAllArchivesFlag	;# used in CreateListOfibiProperties2
				}
			} else {
# HTTP
if {[info exists printFlag] && $printFlag} {
	puts "CreateResponseList: HTTP request<BR>"
	puts http://$recipientAddress?$messageContent<BR><BR>
}

if 0 {
# not needed
# futhermore it seems to produce a "HTTP Dual Stack" error (see e-mail of noc@nic.br in 2019-03-20)
				if $agencyStructureFlag {	;# added by GJFB on 2019-03-20
					regsub {/.*} $recipientAddress {} agencyHTTPHost
# puts $agencyHTTPHost
					set site [ReturnHTTPHost $recipientAddress]
# puts $site
					set url http://$site/info
					if [catch {http::geturl [ConvertURLToHexadecimal $url]}] {
# agencyHTTPHost is down
						set agencyFailureFlag 1
						break
					}
				}
}

# set xxx "CreateResponseList: http://$recipientAddress?$messageContent"
# Store xxx C:/tmp/bbb.txt auto 0 a

# timeout of 2400 ms (1800 is not enough) is for completion of Get- or Get of a restricted access document:
# http://mtc-m05.sid.inpe.br/rep/sid.inpe.br/iris@1905/2005/08.02.21.58.54?metadatarepository=sid.inpe.br/iris@1905/2005/08.02.21.58.56&languagebutton=pt-BR&ibiurl.requiredsite=mtc-m05.sid.inpe.br&ibiurl.requiredtimestamp=2013:08.23.17.34.02&requiredmirror=sid.inpe.br/banon/2001/04.03.15.36.19&searchsite=bibdigital.sid.inpe.br:80&searchmirror=sid.inpe.br/bibdigital@80/2006/04.07.15.50.13&choice=brief
# timeout of 3000 ms (2400 is not enough) is for completion of export from URLibUSB running in gerald:
# http://gjfb:1905/download.cgi/dpi.inpe.br/banon-pc2@1905/2005/10.05.18.39/?languagebutton=pt-BR&requiredmirror=dpi.inpe.br/banon-pc3.1905/2010/10.18.14.52.45

#				if [catch {http::geturl [ConvertURLToHexadecimal http://$site/J8LNKB5R7W/3FTRH3S?$queryString] -command CreateListOfibiProperties -timeout 3000} token] #	;# commented by GJFB on 2014-06-30 - 3s is too much time compared to the 5s below - 5s - 3s = 2s is too less time left to return the response - tested once with Apache server at banon-pc.dpi.inpe.br:1910 not responding 
#				if [catch {http::geturl [ConvertURLToHexadecimal http://$site/J8LNKB5R7W/3FTRH3S?$queryString] -command CreateListOfibiProperties -timeout 1000} token] #	;# commented by GJFB on 2014-07-06 - 1s is not enough time for gjfb to execute ReturnIntranetConfiguration and UpdateArchivingPolicy (in GetURLPropertyList) in case of a Joural Article
#				if [catch {http::geturl [ConvertURLToHexadecimal http://$site/J8LNKB5R7W/3FTRH3S?$queryString] -command CreateListOfibiProperties -timeout 4000} token] #	;# commented by GJFB on 2014-07-08 - now, in case of Journal Article, it is not necessary waiting for non existing repository in the local scope - 2s seems enought to solve an Journal Article access
#				if [catch {http::geturl [ConvertURLToHexadecimal http://$site/J8LNKB5R7W/3FTRH3S?$queryString] -command CreateListOfibiProperties -timeout 2000} token] #	;# commented by GJFB on 2014-08-30 - now, in case of Journal Article, it is not necessary waiting for non existing repository in the local scope - 3s seems enought to solve an Journal Article access
#				if [catch {http::geturl [ConvertURLToHexadecimal http://$site/J8LNKB5R7W/3FTRH3S?$queryString] -command CreateListOfibiProperties -timeout 3000} token] #
#				if [catch {http::geturl [ConvertURLToHexadecimal http://$site/$loCoInRep2?$queryString 1] -command CreateListOfibiProperties -timeout 3000} token] #
				if [catch {http::geturl [ConvertURLToHexadecimal http://$recipientAddress?$messageContent 1] -command CreateListOfibiProperties -timeout 3000} token] {	;# see 3. Require URL (Fig. 6.1) - Report id J8LNKB5R7W/3G2EKR5
#				if [catch {http::geturl [ConvertURLToHexadecimal http://$site/83LX3pFwXQZeBBx/fJ3Bm?$queryString] -command CreateListOfibiProperties -timeout 12000} token] # needed to run "Tabela fornecendo os dados para o cálculo dos indicadores Físicos e Operacionais IPUB e IGPUB: ano de 2016" without error of the type: "CreateOutput: unexpected searchResult value: archiveaddress mtc-m16c.sid.inpe.br contenttype Data ...#
if $storeFlag {
 if [info exists applicationNameForReverseEngineering] {
	set xxx {catch returns 1}
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx $token
	Store xxx $homePath/bbb.txt auto 0 a
 }
}
					incr numberOfResponses
					if $agencyStructureFlag {	;# added by GJFB on 2019-03-20
						set agencyFailureFlag 1
						break
					}
				} else {
if $storeFlag {
 if [info exists applicationNameForReverseEngineering] {
	set xxx {catch returns 0}
	Store xxx $homePath/bbb.txt auto 0 a
 }
}
if $storeFlag {
 if [info exists applicationNameForReverseEngineering] {
	set xxx $token
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx $recipientAddress
	Store xxx $homePath/bbb.txt auto 0 a
 }
}
					lappend tokenList $token
					set ${token}(scanall) $scanAllArchivesFlag	;# used in CreateListOfibiProperties
				}
# puts $token
			}
		}	;# end foreach
# puts $messageContent
# puts $numberOfResponses

		if $agencyStructureFlag {	;# added by GJFB on 2019-03-20
			if !$agencyFailureFlag {
				foreach token $tokenList {
					if ![info exists ${token}(sock)] {	;# added by GJFB on 2018-06-04 - required to detect an agency resolver down (ex: licuri.ibict.br), otherwise the while below ends at timeout which is to much time to wait for; furthermore ${token}(status) below doesn't exist and [http::status $token] produces an error
#						return {}
						set agencyFailureFlag 1
					}
				}
			}
			if $agencyFailureFlag {
				if {0 && ([string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol])} {
# USP
					foreach token $tokenList {
						CleanUp $token
					}
					CleanUpTable $pID
				} else {
# HTTP
					foreach token $tokenList {
						http::cleanup $token
					}
				}
				return {}
			}
		}

#		if $agencyStructureFlag {	;# removed by GJFB on 2019-03-20
#			set agencyFailureFlag [expr $numberOfResponses > 0]	;# 1 means that at list one agency connection fails
#		}
	
		set flag 1	;# enable while
		set time 0
# puts $tokenList
# WHILE
		while {$flag} {
#			if $time #
				set xWaitQueue 0; after 100 {set xWaitQueue 1}; vwait xWaitQueue
				incr time 100
#			# else #
#				set xWaitQueue 0; after 300 {set xWaitQueue 1}; vwait xWaitQueue	;# added by GJFB on 2019-03-28 - tuned from vaio:1905
#				incr time 300
#			#
			foreach token $tokenList {
if $storeFlag {
if {$time == 300} {
 if [info exists applicationNameForReverseEngineering] {
	set xxx $token
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx [info exists ${token}(found)]
	Store xxx $homePath/bbb.txt auto 0 a
 }
}
}
				if [info exists ${token}(found)] {
# puts ($token)	;# nice puts
# puts [set ${token}(found)]	;# nice puts
					if !$scanAllArchivesFlag {
						if {[set ${token}(found)] == 1} {set flag 0; break}	;# the required item has been found
					}
					if [set ${token}(found)] {
						incr numberOfResponses
						set ${token}(found) 0	;# set to 0 in order to incr numberOfResponses only once while the while is running
						if {$numberOfResponses == $numberOfSites} {set flag 0; break}	;# all the sites have been processed
					}
				} elseif 0 {
# host is down
					if $agencyStructureFlag {	;# added by GJFB on 2019-03-20
						if {0 && ([string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol])} {
# USP
							foreach token $tokenList {
								CleanUp $token
							}
							CleanUpTable $pID
						} else {
# HTTP
							foreach token $tokenList {
								http::cleanup $token
							}
						}
						return {}
					}
					set index [lsearch $tokenList $token]
					set tokenList [lreplace $tokenList $index $index]
					incr numberOfResponses
					if {0 && ([string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol])} {
# USP
						CleanUp $token
					} else {
# HTTP
						http::cleanup $token
					}
				}
			}
#			if {$time > 5000} {set flag 0}	;# time-out
#			if {$time > 8000} {set flag 0}	;# time-out (4s + 4s) - 4s is timeout for http::geturl - 4s is to let Apache server respond
#			if {$time > 6000} {set flag 0}	;# time-out (2s + 4s) - 2s is timeout for http::geturl - 4s is to let Apache server respond
			if {$time > 7000} {set flag 0}	;# time-out (3s + 4s) - 3s is timeout for http::geturl - 4s is to let Apache server respond
#			if {$time > 16000} {set flag 0}	;# time-out (12s + 4s) - 2s is timeout for http::geturl - 4s is to let Apache server respond
		}	;# end of WHILE
	
if $storeFlag {
 if [info exists applicationNameForReverseEngineering] {
	set xxx "time = $time"
	Store xxx $homePath/bbb.txt auto 0 a
	set xxx [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]
	Store xxx $homePath/bbb.txt auto 0 a
 }
}

# Create listOfibiProperties
		set listOfibiProperties {}
		foreach token $tokenList {
# puts --[http::data $token]--	;# data is empty when status is not ok
# puts [http::status $token]
# puts $xWaitQueue
			if {0 && ([string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol])} {
# USP
				if [string equal {ok} [set ${token}(status)]] {
# puts $token
					set ibiProperties [set ${token}(data)]	;# 1(data) -> ibiProperties
# puts --$ibiProperties--
					CleanUp $token
					if [regexp {^<} $ibiProperties] {
# ibiProperties contains an error message
					} else {
# norm simplification (part of the implementation not needed)
if 1 {
						set listOfibiProperties [concat $listOfibiProperties $ibiProperties]
} else {
						lappend listOfibiProperties $ibiProperties
}
					}
				}
			} else {
# HTTP
if 0 {
 set xxx --[::http::code  $token]--
 Store xxx C:/tmp/bbb.txt auto 0 a
 set xxx --[::http::status  $token]--
 Store xxx C:/tmp/bbb.txt auto 0 a
 set xxx --[::http::error  $token]--
 Store xxx C:/tmp/bbb.txt auto 0 a
}
				if [string equal {ok} [http::status $token]] {
#				if {[info exists ${token}(status)] && [string equal {ok} [http::status $token]]} #	;# no more required - see the addition above by GJFB on 2018-06-04
# puts $token
					set ibiProperties [string trim [http::data $token]]
# puts --$ibiProperties--
					http::cleanup $token
					if [regexp {^<} $ibiProperties] {
# ibiProperties contains an error message
					} else {
# norm simplification
if 0 {
						set listOfibiProperties [concat $listOfibiProperties $ibiProperties]
} else {
						lappend listOfibiProperties $ibiProperties
}
					}
				}
			}
		}
# Create listOfibiProperties - end
	
		if {0 && ([string equal {} $archiveProtocol] || [string equal {USP} $archiveProtocol])} {
# USP
# Free memory
			CleanUpTable $pID
# Free memory - end
		}
	}
# puts --$listOfibiProperties--
# Store listOfibiProperties C:/tmp/bbb.txt auto 0 a

	if {0 || $agencyStructureFlag} {
#		if {!$agencyFailureFlag && [string equal {} $listOfibiProperties]} #	;# removed by GJFB on 2019-03-20
		if [string equal {} $listOfibiProperties] {	;# added by GJFB on 2019-03-20
# ibi not found
			set callingProcedureName {}
			set contextLanguage $selectedLanguageFromMirror
			DisplayWarningMessage $ibi $callingProcedureName $contextLanguage $languageRep1 $languageRep2 $localSite	;# runs an error command
		}
	}	

	return $listOfibiProperties
}
	
# CreateResponseList - end
# ----------------------------------------------------------------------
# EscapeUntrustedData
# added by GJFB on 2018-06-08 - escapes untrusted data (XSS prevention) and tcl code ($)
# https://www.ascii.cl/htmlcodes.htm

proc EscapeUntrustedData {value {ampFlag 0}} {
if 1 {
	regsub -all {<} $value {\&lt;} value
	regsub -all {>} $value {\&gt;} value
} else {
# doesn't dispense with & coding below
	regsub -all {<} $value {\&#60;} value
	regsub -all {>} $value {\&#62;} value
}
	if {1 && $ampFlag} {
		regsub -all {&} $value {\&amp;} value	;# puts required when using the alt attribute of an img tag (see option Gallery in DisplayDocContent) - the alt attribute value may contain an untrusted data from a contentDescriptionList
	}
	regsub -all {\$} $value {\&#36;} value	;# added by GJFB on 2018-06-14 - for displaying string like cr$30
	return $value
}

# EscapeUntrustedData - end
# ----------------------------------------------------------------------
# CreateSymmetricKey

proc CreateSymmetricKey {} {
	set randomNumber [SortRandomNumber]
	set string1 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
	set string $string1
	set stringLength [string length $string]
	set string2 {}
	while {$stringLength != 0} {
		set randomNumber [expr ($randomNumber * 9301 + 49297) % 233280]
		set i [expr $randomNumber * $stringLength / 233280]
		append string2 [string index $string $i]
		set string [string replace $string $i $i]
		set stringLength [string length $string]		
	}
	return $string2
}

if 0 {
# testing
	source utilities1.tcl
	source cgi/mirrorfind-.tcl	
	set homePath {C:/Users/Sony/URLib 2}
	set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
	CreateSymmetricKey
# =>
# G5pI2leXqFhZtoxYLnHM6UKSbfkRCQmjN0JyzgB7si4wa1WDcdVrPEv398TAOu
}

# CreateSymmetricKey - end
# ----------------------------------------------------------------------
# CodeKey
# string1 -> string2
# used by Submit (in cgi/submit.tcl when creating a password for the user), SendSubmissionConfirmationEMail and SendPermissionTransferWarningEMail only
# publicKey - added by GJFB on 2019-01-16

proc CodeKey {value {publicKey {}}} {
	set string1 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
	if [string equal {} $publicKey] {
		set string2 uYqbALReBN8cEUjfzQWXOJv3Zlmr5s7PSDGoFx9Kg0a2n6CwkHVMi4yT1Idpht
	} else {
		set string2 $publicKey
	}
	set newValue {}
	foreach character [split $value {}] {
		set index [string first $character $string1]
		if {$index == -1} {
			append newValue $character
		} else {
			append newValue [string index $string2 $index]
		}
	}
	return $newValue
}

if 0 {
# testing
	source utilities1.tcl
	source cgi/mirrorfind-.tcl	
	set homePath {C:/Users/Sony/URLib 2}
	set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
	CodeKey x!x [CreateSymmetricKey]
# =>
# abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
# G5pI2leXqFhZtoxYLnHM6UKSbfkRCQmjN0JyzgB7si4wa1WDcdVrPEv398TAOu
# S!S
}

# CodeKey - end
# ----------------------------------------------------------------------
# DecodeKey
# string2 -> string1
# used in StorePassword and CheckPassword only
# sessionTime value are milliseconds - added by GJFB on 2019-01-16

proc DecodeKey {value {sessionTime {}}} {
	set string1 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890; set string2 uYqbALReBN8cEUjfzQWXOJv3Zlmr5s7PSDGoFx9Kg0a2n6CwkHVMi4yT1Idpht
	set newValue {}
	foreach character [split $value {}] {
		set index [string first $character $string2]
		if {$index == -1} {
			append newValue $character
		} else {
			append newValue [string index $string1 $index]
		}
	}
	return $newValue
}

# DecodeKey - end
# ----------------------------------------------------------------------
# UpdateContentDescriptionFile
# used in DisplayDocContent and UpdateRepMetadataRep only
# create or update contentDescription.tcl

proc UpdateContentDescriptionFile {rep targetFile} {
	global homePath

# targetFileExtension
#	if [regexp -nocase {\.(bmp|jpg)$} [file extension $targetFile]] #
	if [regexp -nocase {\.(bmp|jpg|jpeg)$} [file extension $targetFile]] {	;# added by GJFB on 2020-07-27
		set docPath $homePath/col/$rep/doc
		set targetDirName [file dirname $targetFile]	;# added by GJFB on 2020-03-25

# Create imageList
		set pwd [pwd]
#		cd $docPath
		cd $docPath/$targetDirName	;# added by GJFB on 2020-03-25 to work with images in directories
		set imageList {}
		set imageList [concat $imageList [glob -nocomplain {*.[bB][mM][pP]}]]
		set imageList [concat $imageList [glob -nocomplain {*.[jJ][pP][gG]}]]
		set imageList [concat $imageList [glob -nocomplain {*.[jJ][pP][eE][gG]}]]	;# added by GJFB on 2020-07-27
		cd $pwd
# Create imageList - end

# puts $imageList

#		if [file exists $docPath/contentDescription.tcl] #
		if [file exists $docPath/$targetDirName/contentDescription.tcl] {	;# added by GJFB on 2020-03-25 to work with images in directories
  			if ![interp exists slave] {
	  			interp create -safe slave
  				interp expose slave source
			}
## Load $docPath/contentDescription.tcl fileContent
# Load $docPath/$targetDirName/contentDescription.tcl fileContent
# puts $fileContent
#			set contentDescriptionList [interp eval slave [list source $docPath/contentDescription.tcl]]	;# set contentDescriptionList
			set contentDescriptionList [interp eval slave [list source $docPath/$targetDirName/contentDescription.tcl]]	;# set contentDescriptionList - added by GJFB on 2020-03-25 to work with images in directories
if 0 {
# contentDescriptionArray
			array set contentDescriptionArray $contentDescriptionList
			
# Add prefix zzz
# added by GJFB on 2018-10-01 - turns easier ranking of the first few images
			foreach name [array names contentDescriptionArray] {
				if [regsub {^,} $name {zzz,} name2] {
					set contentDescriptionArray($name2) $contentDescriptionArray($name)
					unset contentDescriptionArray($name)
				}
			}
# Add prefix zzz - end
}

		}
# imageList
# => DSCN0239.JPG DSCN0241.JPG DSCN0240.JPG
# a,DSCN0239.JPG aa,DSCN0241.JPG ab,DSCN0240.JPG

if 0 {
# commented by GJFB on 2020-07-29
# Add lines of new images
		foreach imageName $imageList {
			set imageName2 [array names contentDescriptionArray *,$imageName]
			if [string equal {} $imageName2] {
#				set contentDescriptionArray(,$imageName) {}	;# set a new entry
				set contentDescriptionArray(zzz,$imageName) {}	;# set a new entry - added by GJFB on 218-10-01 - turns easier ranking of the first few images
			}
		}
# Add lines of new images - end
		
# Delete lines of deleted images
		foreach imageName [array names contentDescriptionArray] {
			regsub {.*?,} $imageName {} imageName2
			if {[lsearch $imageList $imageName2] == -1} {
				unset contentDescriptionArray($imageName)
			}
		}
# Delete lines of deleted images - end

##		StoreArray contentDescriptionArray $docPath/contentDescription.tcl w list array 1 {} 1 dictionary
#		StoreArray contentDescriptionArray $docPath/$targetDirName/contentDescription.tcl w list array 1 {} 1 dictionary
		set contentDescriptionList [array get contentDescriptionArray]
} else {
# added by GJFB on 2020-07-29 - new image ranking facility
		if ![info exists contentDescriptionList] {set contentDescriptionList {}}
# puts $contentDescriptionList
		set imageList [lsort -dictionary $imageList]
	
		set imageList2 {}
		foreach {imageName2 imageLegend} $contentDescriptionList {
if 0 {
# commented by GJFB on 2021-04-28 - doesn't work whith file name like {7_ Folha de S. Paulo, sem data,  arquivo Dr. Mendonça.jpg}
			regsub {.*?,} $imageName2 {} imageName2	;# remove initial string like azz,001.jpg - migration to the new image ranking facilicity
} else {
# added by GJFB on 2021-04-28
			if [regexp {^[a-z]*,[^ ]} $imageName2] { 
				regsub {^[a-z]*,?} $imageName2 {} imageName2	;# remove initial string like azz,001.jpg - migration to the new image ranking facilicity
			}
}
			lappend imageList2 $imageName2
		}
# puts $imageList
# => {WhatsApp Image 2022-08-31 at 13.53.10.jpeg} {WhatsApp Image 2022-08-31 at 14.10.26.jpeg}	
# puts $imageList2
# => {WhatsApp Image 2022-08-31 at 13.53.10.jpeg} 		
		set oldImageList [ListIntersection imageList2 imageList]	;# old images to be preserved
# puts $oldImageList
# => {WhatsApp Image 2022-08-31 at 13.53.10.jpeg} 		
#		set newImageList [ListNegatedImplication imageList imageList2]	;# commented by GJFB on 2022-10-08 because image lists might be lists of lists
# puts $newImageList	;# visible at post after a form update
#{ => 14.10.26.jpeg}	
		set newImageList [ListNegatedImplication2 imageList imageList2]	;# added by GJFB on 2022-10-08 because image lists might be lists of lists
# puts $newImageList
# => {WhatsApp Image 2022-08-31 at 14.10.26.jpeg}	
		set imageList2 {}
		foreach {imageName2 imageLegend} $contentDescriptionList {
if 0 {
# commented by GJFB on 2021-04-28 - doesn't work whith file name like {7_ Folha de S. Paulo, sem data,  arquivo Dr. Mendonça.jpg}
			regsub {.*?,} $imageName2 {} imageName2	;# remove initial string - migration to the new image ranking facilicity
} else {
# added by GJFB on 2021-04-28
			if [regexp {^[a-z]*,[^ ]} $imageName2] { 
				regsub {^[a-z]*,?} $imageName2 {} imageName2	;# remove initial string - migration to the new image ranking facilicity
			}
}
			if {[lsearch $oldImageList $imageName2] != -1} {
				lappend imageList2 $imageName2 $imageLegend	;# append old image
			}
		}
		
		foreach imageName $newImageList {
			lappend imageList2 $imageName {}	;# append new image
		}
		
		set contentDescriptionList $imageList2
}
	
if 0 {
# id 8JMKD3MGPGW/3EDF795
if [string equal {utf-8} [encoding system]] {
set contentDescriptionList [encoding convertfrom utf-8 $contentDescriptionList]	;# solves the accent problem - added by GJFB on 2010-12-11 - needed when displaying a full reference of plutao (see for example title of J8LNKAN8RW/38JE8FB in plutao (working with utf-8)) from banon-pc3
}
}
#		StoreArray contentDescriptionList $docPath/contentDescription.tcl w list listforarray 1 {} 1 dictionary
#		StoreArray contentDescriptionList $docPath/$targetDirName/contentDescription.tcl w list listforarray 1 {} 1 dictionary	;# added by GJFB on 2020-03-25 to work with images in directories
		set header "# <pre>\n# The line order below defines the image order in the gallery\n"
		Store header $docPath/$targetDirName/contentDescription.tcl
		StoreArray contentDescriptionList $docPath/$targetDirName/contentDescription.tcl a list listforarray 1 {} 0 none	;# added by GJFB on 2020-07-29 to include a warning line
		set footer "\n# </pre>"
		Store footer $docPath/$targetDirName/contentDescription.tcl auto 0 a
	}
}
		
# UpdateContentDescriptionFile - end
# ----------------------------------------------------------------------
# BuildReturnPathArray
# recurrent procedure
# idNextTitle is a list of the type: {identifier nexthigherunit shorttitle} (nexthigherunit and shorttitle are with respect to identifier)
# returnPathArray entries are lists of the type: {... identifier2 shorttitle2 identifier1 shorttitle1}
# used in Get, StoreReturnPathArray only and remotely in this procedure

proc BuildReturnPathArray {idNextTitle agencyStructureFlag i returnPathArrayList missingNextHigherUnitIBIList} {
	global serverAddress
	global urlibServerAddress
#	global queryString
	
# >>> to see the puts output (at the first iteration) go to the bottom of the source code page of the upper menu (no other steps are required when running Get)
# puts >>>[list $idNextTitle $i]
# => {{} {3ERPFQRTRW34M/3E7G88S 3ERPFQRTRW34M/3EHNQ68} {}} 1
# => {{} 83LX3pFwXQZeBBx/BbsHa BDMCI} 1
# puts --$returnPathArrayList--
# => ----
	foreach {id unitList shortTitle} $idNextTitle {break}
	array set returnPathArray $returnPathArrayList
	if ![info exists returnPathArray($i)] {set returnPathArray($i) {}}
	set returnPathUpToNow $returnPathArray($i)
# puts 1--$unitList--
	foreach unit $unitList {
		if ![info exists returnPathArray($i)] {set returnPathArray($i) {}}
# puts 2--$unit--
# puts 3--$returnPathArray($i)--
# puts 4--[lindex $returnPathArray($i) end-3]--
# puts [string equal $unit [lindex $returnPathArray($i) end-3]]
		if [string equal $unit [lindex $returnPathArray($i) end-3]] {	;# if and its content added by GJFB on 2023-01-29 to avoid infinite loop
			incr i
			continue	;# next unit
		}
		if [info exists urlPropertyArray] {unset urlPropertyArray}
		set returnPathArray($i) [concat [list $id $shortTitle] $returnPathUpToNow]
# puts 1-[list $returnPathArray($i) $i]
# => 1-{{} BDMCI} 1
# puts $unit
# http://gjfb/J8LNKB5R7W/3D3EHEL?ibiurl.metadatafieldnamelist=identifier+nexthigherunit+shorttitle
# http://gjfb/J8LNKB5R7W/3EHTB7P?ibiurl.metadatafieldnamelist=identifier+nexthigherunit+shorttitle
# http://gjfb.home/J8LNKB5R7W/3EB9F8L?ibiurl.metadatafieldnamelist=identifier+nexthigherunit+shorttitle
#		set parsedIBIURL [list parsedibiurl.ibi $unit parsedibiurl.metadatafieldnamelist {identifier nexthigherunit shorttitle}]	;# used in Get - commented by GJFB on 2018-01-09
		set parsedIBIURL [list parsedibiurl.ibi $unit parsedibiurl.metadatafieldnamelist {identifier nexthigherunit shorttitle title}]	;# used in Get - added by GJFB on 2018-01-09

		set displayWarningMessage 0
if 0 {
# commented by GJFB on 2021-02-16
#		set useURLibServerFlag 0	;# try locally first - commented by GJFB on 2017-02-20
#		set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} $useURLibServerFlag]	;# commented by GJFB on 2017-02-20
		set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} 0 $agencyStructureFlag]	;# added by GJFB on 2017-02-20
} else {
# added by GJFB on 2021-02-16 for Federated Archives that have agreed to share the same group value standard to grant them to find the nexthigher records by using the extended search option
#		set useURLibServerFlag 1	;# search extended to urlib.net
#		set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage () $useURLibServerFlag]	;# search extended to urlib.net - tested but not used because embraces too many sites
		set extendedSearchFlag 1
		set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} 0 $agencyStructureFlag $extendedSearchFlag]	;# added by GJFB on 2017-02-20
}

# puts $parsedIBIURL
# puts $unit
# puts --$urlPropertyList--
		array set urlPropertyArray $urlPropertyList
#		set state $urlPropertyArray(state)
		ConditionalSet state urlPropertyArray(state) {}
#		if [string equal {Deleted} $state] #
		if {[string equal {Deleted} $state] || [string equal {} $state]} {
# deleted or next higher unit not found
#			unset returnPathArray($i)	;# added by GJFB on 2014-08-02 to solve deleted next higher unit, otherwise one gets duplicated return paths
#			if [string equal {Deleted} $state] {unset returnPathArray($i)}	;# added by GJFB on 2014-08-02 to solve deleted next higher unit, otherwise one gets duplicated return paths - commented by GJFB on 2021-05-03
			unset returnPathArray($i)	;# added by GJFB on 2021-05-03 - any incomplete path should be removed
			lappend missingNextHigherUnitIBIList $unit
# puts $missingNextHigherUnitIBIList
			continue	;# added by GJFB on 2014-08-02 to solve deleted next higher unit
		} else {
			ConditionalSet metadataFieldList urlPropertyArray(metadatafieldlist) {}	;# needed by BuildReturnPathArray (see cgi/get.tcl)
		}

# puts [list $site $rep $serverAddress $metadataFieldList]
# => marte2.sid.inpe.br dpi.inpe.br/marte2/2013/05.28.22.25.51 {marte2.sid.inpe.br 802} {identifier 3ERPFQRTRW34M/3E7G88S nexthigherunit {} shorttitle {SBSR 16}}
# serverAddress not used
# metadataFieldList contains the values of identifier, nexthigherunit and shorttitle
# puts --$metadataFieldList--
# => identifier 3ERPFQRTRW34M/3E7G88S nexthigherunit {} shorttitle {SBSR 16}
		foreach {metadataFieldName metadataFieldValue} $metadataFieldList {
			set $metadataFieldName $metadataFieldValue	;# set identifier, nexthigherunit, shorttitle and title (nexthigherunit, shorttitle and title are with respect to identifier)
		}
		
# Create automatic short title			
# added by GJFB on 2018-01-09		
		if [string equal {} $shorttitle] {
			regsub -all {"} $title {} title2	;# added by GJFB on 2018-02-13 to avoid error like 'list element in quotes followed by "," instead of space' when running lrange
			set shorttitle [lrange $title2 0 2]
			if {[llength $title2] > 3} {
				set shorttitle $shorttitle...
			}
		}
# Create automatic short title - end	
		
		set site $urlPropertyArray(archiveaddress)
# puts $site
		set unitServerAddress [GetServerAddressFromHTTPHost $site]			
		set encodingName [Execute $unitServerAddress [list GetEncodingName]]
		if [string equal {utf-8} $encodingName] {
# solves the accent problem - same code is used in xxDocContent.html
			set shorttitle [encoding convertfrom utf-8 $shorttitle]	;# Produção -> Produção - ex: http://www.urlib.net/rep/LK47B6W/362SFKH http://gjfb:1905/rep/LK47B6W/362SFKH
		}
		if [string equal {} $nexthigherunit] {
			set returnPathArray($i) [concat [list $identifier $shorttitle] $returnPathArray($i)]
# puts 2-[list $returnPathArray($i) $i]
# => 3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}
			incr i
			continue	;# next unit
		}
		set returnPathArrayList [array get returnPathArray]
#		set buildOutput [BuildReturnPathArray [list $identifier $nexthigherunit $shorttitle] $agencyStructureFlag $i $returnPathArrayList $missingNextHigherUnitIBIList]

# WARNING: calling BuildReturnPathArray via socket (as below) turns the puts output of BuildReturnPathArray invisible
# puts [list BuildReturnPathArray [list $identifier $nexthigherunit $shorttitle] $agencyStructureFlag $i $returnPathArrayList $missingNextHigherUnitIBIList]
		set buildOutput [Execute $unitServerAddress [list BuildReturnPathArray [list $identifier $nexthigherunit $shorttitle] $agencyStructureFlag $i $returnPathArrayList $missingNextHigherUnitIBIList]]
		
# puts --$buildOutput--	;# might contain an error message 
# >>> to see the puts output go to the bottom of the source code page of the upper menu
		foreach {i returnPathArrayList missingNextHigherUnitIBIList} $buildOutput {break}
		array set returnPathArray $returnPathArrayList
	}
	set returnPathArrayList [array get returnPathArray]
# puts --$returnPathArrayList--
# => --1 {83LX3pFwXQZeBBx/BbsHa urlib.net 83LX3pFwXQZeBBx/hvk3g gjfb:1905 J8LNKB5R7W/3D3EHEL {Fonds GJFB} J8LNKB5R7W/3EDSBFE Álbuns J8LNKB5R7W/3EB9F8L Voyage {} {Le Louvre}}--
	return [list $i $returnPathArrayList $missingNextHigherUnitIBIList]
}

# BuildReturnPathArray - end
# ----------------------------------------------------------------------
# StoreReturnPathArray
# created by GJFB on 2022-02-06
# used in Get and CreateFullEntry only

proc StoreReturnPathArray {nexthigherunit shorttitle agencyStructureFlag currentRep} {
	global homePath
	
	set i 1
	set returnPathArrayList {}
	set missingNextHigherUnitIBIList {}
# BUILDRETURNPATHARRAY (Header|AdvancedUserHeader)
	if [catch {BuildReturnPathArray [list {} $nexthigherunit $shorttitle] $agencyStructureFlag $i $returnPathArrayList $missingNextHigherUnitIBIList} buildOutput] {
		global errorInfo
		puts "<!-- [StoreLog {alert} {StoreReturnPathArray} $errorInfo] -->"	;# to see the error message, see the bottom part of the source code of the menu bar (no other steps are required when running Get)
	} else {
		foreach {i returnPathArrayList missingNextHigherUnitIBIList} $buildOutput {break}
# puts --$returnPathArrayList--
# => --1 {8JMKD3MGP3W34R/44ARCNP {Guias de Publicação} {} {Writing the references...}}--
#		if [info exists returnPathArray] {unset returnPathArray}	;# added by GJFB on 2022-01-10 - commented in by GJFB on 2022-02-06
		if [string equal {} $returnPathArrayList] {
			file delete $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl	;# added by GJFB on 2022-02-06 to remove useless file
		} else {
			array set returnPathArray $returnPathArrayList
			file mkdir $homePath/clipboard3/$currentRep/auxdoc	;# added by GJFB on 2018-03-30
			if [string equal {} $returnPathArray(1)] {	;# if added by GJFB on 2021-02-02 to avoid useless file
				file delete $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl	;# added by GJFB on 2021-02-02 to remove useless file
			} else {
				StoreArray returnPathArray $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl w list array 1	;# added by GJFB on 2018-03-30 to allow a remote Archive (like urlib.net) to store returnPathArray.tcl
			}
		}
# missingNextHigherUnitIBIList is computed in BuildReturnPathArray
# when missingNextHigherUnitIBIList is not empty (i.e., there are some missing next higher units) and licuri goes down,
# it is necessary to edit the file @siteList.txt dropping the corresponding tailing 1, otherwise the menu bar is delayed for 12 to 23 s

# puts --$missingNextHigherUnitIBIList--
		if [llength $missingNextHigherUnitIBIList] {
# There are missing next higher units
			Store missingNextHigherUnitIBIList $homePath/clipboard3/$currentRep/auxdoc/missingNextHigherUnitIBIList.txt	;# added by GJFB on 2018-03-30 to allow a remote Archive (like urlib.net) to store missingNextHigherUnitIBIList.txt
		} else {
			file delete $homePath/clipboard3/$currentRep/auxdoc/missingNextHigherUnitIBIList.txt	;# added by GJFB on 2018-03-30
		}
	}
	return $returnPathArrayList
}

# StoreReturnPathArray - end
# ----------------------------------------------------------------------
# GetDefaultBibliographicMirror
# used in Get only

proc GetDefaultBibliographicMirror {} {
	global loBiMiRep
	
	return $loBiMiRep
}

# GetDefaultBibliographicMirror - end
# ----------------------------------------------------------------------
# GetUnfairAddrList

proc GetUnfairAddrList {} {
	global unfairAddrList
	
	if [info exists unfairAddrList] {return $unfairAddrList}
}

# GetUnfairAddrList - end
# ----------------------------------------------------------------------
# FindIdentifierNameFromIBI
# used only in Get, GetURLPropertyList, CreateTclPage and MirrorSearch
# ibi can be a repository name
# ibi must be a repository name when metadataFlag is 1 (metadata should don´t have opaque ibi)
# if identifier doesn´t exist then the repository name is returned

proc FindIdentifierNameFromIBI {ibi {metadataFlag 0}} {
	
	if $metadataFlag {
# usually metadata doesn´t have opaque ibi (dpi.inpe.br/banon-pc3@80/2009/11.10.13.03.32 is an exception)
		set identifier $ibi
	} else {
		if {[regexp -all {/} $ibi] == 3} {
# rep
			LoadService $ibi identifier identifier 1 1
			if [string equal {} $identifier] {
				set identifier $ibi
			}
		} else {
# opaque ibi (ibip or ibin)
			set identifier $ibi
		}
	}
	return $identifier
}

# FindIdentifierNameFromIBI - end
# ----------------------------------------------------------------------
# ConvertStringWithAccent
# used in Submit (cgi/submit.tcl) and Get (cgi/get.tcl)
# added by GJFB on 2023-02-14

proc ConvertStringWithAccent {stringName} {
	upvar $stringName string
	
# loser case
	regsub -all {a&#768;} $string {à} string
	regsub -all {a&#769;} $string {á} string
	regsub -all {a&#770;} $string {â} string	;# french
	regsub -all {a&#771;} $string {ã} string
	
	regsub -all {c&#807;} $string {ç} string
	
	regsub -all {e&#768;} $string {è} string	;# french
	regsub -all {e&#769;} $string {é} string
	regsub -all {e&#770;} $string {ê} string
	regsub -all {e&#776;} $string {ë} string	;# french
	
	regsub -all {i&#769;} $string {í} string
	regsub -all {i&#770;} $string {î} string	;# french
		
	regsub -all {o&#769;} $string {ó} string	
	regsub -all {o&#770;} $string {ô} string	
	regsub -all {o&#771;} $string {õ} string
	
	regsub -all {u&#768;} $string {ù} string	;# french
	regsub -all {u&#769;} $string {ú} string	
	regsub -all {u&#770;} $string {û} string	;# french

# upper case
	regsub -all {A&#768;} $string {À} string
	regsub -all {A&#769;} $string {Á} string
	regsub -all {A&#770;} $string {Â} string	;# french
	regsub -all {A&#771;} $string {Ã} string
	                                       
	regsub -all {C&#807;} $string {Ç} string
	                                       
	regsub -all {E&#768;} $string {È} string	;# french
	regsub -all {E&#769;} $string {É} string
	regsub -all {E&#770;} $string {Ê} string
	regsub -all {E&#776;} $string {Ë} string	;# french
	                                       
	regsub -all {I&#769;} $string {Í} string
	regsub -all {I&#770;} $string {Î} string	;# french
		                                   
	regsub -all {O&#769;} $string {Ó} string	
	regsub -all {O&#770;} $string {Ô} string	
	regsub -all {O&#771;} $string {Õ} string
	                                       
	regsub -all {U&#768;} $string {Ù} string	;# french
	regsub -all {U&#769;} $string {Ú} string	
	regsub -all {U&#770;} $string {Û} string	;# french
	
}

# ConvertStringWithAccent - end	
# ----------------------------------------------------------------------
# CreateMetadataTags
# added by GJFB on 2023-02-22 for Search engine optimization (SEO)
# used by CreateMetadata (cgi/oai.tcl) and Get (cgi/get.tcl)
# site value is for example: gjfb 19050
# localSite value is for example: gjfb:1905
# item == metadatarep-i
# tagType value is DC or dc for DublinCore (DC.title) or HP for HighwirePress (citation_title)
# dc is used with OAI and DC for SEO
# with dc, no HTML codification is applied in abstract - this is a request from Roberto Novaes Rocha (BDTD) implemented in 2012-12-04 - idem mtd2-br
# identifierType value is URL or IBI
# errorLogPath is $homePath/col/$OAIProtocolRepository/auxdoc/@errorLog
# or $homePath/@errorLog
# dcType value is OAI (default) or SEO - added by GJFB on 2023-08-31 to make the difference between two types of DC usage 

# the code outside CreateMetadataTags to obtain field::conversionTable is:
#	set englishMirrorRepository $env(ENGLISH_MIRROR_REP)
#	GetConversionTable $englishMirrorRepository en
#	global field::conversionTable

# references:
# https://scholarworks.montana.edu/xmlui/handle/1/3193
# https://scholar.google.com/intl/en/scholar/inclusion.html

proc CreateMetadataTags {site item tagType identifierType errorLogPath {dcType OAI}} {
	global env
	global localSite
	global field::conversionTable

# referenceType
#	set referenceType [Execute $site [list ReturnType metadataArray $item]]
#	if [string equal {} $referenceType] #
	if [catch {SetFieldValue $site $item {referencetype} 1}] {
# Gateway Time-out
# 1
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreateMetadataTags (1): Gateway Time-out"
		Store log $errorLogPath auto 0 a
		puts "Location: http://$localSite/e/504"
		puts ""
		return -code return
	}

# thesistype
	if [catch {SetFieldValue $site $item {thesistype} 1}] {
# Gateway Time-out
# 1
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreateMetadataTags (1): Gateway Time-out"
		Store log $errorLogPath auto 0 a
		puts "Location: http://$localSite/e/504"
		puts ""
		return -code return
	}

# see http://dublincore.org/documents/dces/
# fieldList
	global fieldList$referencetype
	if ![info exists fieldList$referencetype] {
if 0 {
# commented by GJFB on 2024-08-12 - doesn't work when the URLib port is not 800
		set fieldList$referencetype [Execute $localSite [list ReturnReferModel $referencetype]]
} else {
# added by GJFB on 2024-08-12 - serverAddress must be used instead of localSite due to a limitation of Execute
		set serverAddress [GetServerAddressFromHTTPHost $localSite]
		set fieldList$referencetype [Execute $serverAddress [list ReturnReferModel $referencetype]]
}
		if [string equal {} [set fieldList$referencetype]] {
# Gateway Time-out
# 2
			set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreateMetadataTags (2): Gateway Time-out"
			Store log $errorLogPath auto 0 a
			puts "Location: http://$localSite/e/504"
			puts ""
			return -code return
		}
	}
	foreach field [set fieldList$referencetype] {
		lappend referList [lindex $field 0]	;# %A
		lappend referList [lindex $field 1]	;# author
	}
	
# referArray
	array set referArray $referList
	if ![info exists referArray(%D)] {set referArray(%D) {}}	;# if referArray(%D) doesn't exist then 'set referArray(%D)' returns empty (see GetFieldValue)
	if ![info exists referArray(%B)] {set referArray(%B) {}}
	if ![info exists referArray(%V)] {set referArray(%V) {}}
	if ![info exists referArray(%N)] {set referArray(%N) {}}
	if ![info exists referArray(%P)] {set referArray(%P) {}}
	if ![info exists referArray(%I)] {set referArray(%I) {}}
	
# SETFIELDVALUE
#	if [catch {SetFieldValue $site $item [list $referArray(%T) $referArray(%A) $referArray(%D) $referArray(%I) keywords abstract $referArray(%P) language repository size] 1}] #	;# commented by GJFB on 2018-04-09
#	if [catch {SetFieldValue $site $item [list $referArray(%T) $referArray(%A) $referArray(%D) publisher keywords abstract $referArray(%P) language repository identifier size agency] 1}] #
#	if [catch {SetFieldValue $site $item [list $referArray(%T) $referArray(%A) $referArray(%D) publisher keywords abstract $referArray(%P) language repository identifier size] 1}] #	;# added by GJFB on 2018-04-09 - commented by GJFB on 2023-02-27
	if [catch {SetFieldValue $site $item [list title $referArray(%A) $referArray(%D) $referArray(%I) keywords abstract $referArray(%P) language repository identifier size $referArray(%I) reportnumber $referArray(%B) $referArray(%V) $referArray(%N) issn isbn targetfile doi contenttype] 1}] {	;# added by GJFB on 2023-02-27 - set title ...
# Gateway Time-out
# 3
		set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] CreateMetadataTags (3): Gateway Time-out"
		Store log $errorLogPath auto 0 a
		puts "Location: http://$localSite/e/504"
		puts ""
		return -code return
	}
	
	set J [regexp {^Journal Article$} $referencetype]
	set C [regexp {^Conference Proceedings$} $referencetype]
	set JC [expr $J || $C]
	set T [regexp {^Thesis$} $referencetype]
	set R [regexp {^Report$} $referencetype]
	set TR [expr $T || $R]
		
# title
#	lappend outputList "$tabulation				<dc:title>[Convert $title]</dc:title>"
	if [string equal -nocase {DC} $tagType] {lappend outputList DC.title $title}
	if [string equal {HP} $tagType] {lappend outputList citation_title $title}
	
# creator
#	set creatorList [subst $$referArray(%A)]
	set creatorList [set $referArray(%A)]
#	regsub -all ",\}" $creatorList "\}" creatorList ;# drop trailing comma
	foreach creator $creatorList {
		regsub {,*$} $creator {} creator
		if [string equal -nocase {DC} $tagType] {lappend outputList DC.creator $creator}
		if [string equal {HP} $tagType] {lappend outputList citation_author $creator}
# puts $creator
	}
	
# date
	if ![string equal {} [set $referArray(%D)]] {
#		if {[string equal -nocase {DC} $tagType] && $JC} {lappend outputList DCTERMS.issued [set $referArray(%D)]}
#		if {[string equal -nocase {DC} $tagType] && $JC} {lappend outputList DC.date.issued [set $referArray(%D)]}	;# commented by GJFB on 2023-08-31
#		if {[string equal -nocase {DC} $tagType] && !$JC} {lappend outputList DC.date [set $referArray(%D)]}	;# commented by GJFB on 2023-08-31
		if [string equal -nocase {DC} $tagType] {
			if [string equal {OAI} $dcType] {	;# added by GJFB on 2023-08-31
# OAI
				lappend outputList DC.date [set $referArray(%D)]
			} else {
# SEO
				lappend outputList DC.date.issued [set $referArray(%D)]
			}
		}
		if [string equal {HP} $tagType] {lappend outputList citation_publication_date [set $referArray(%D)]}
	}
	
# journal/conferencename
	if ![string equal {} [set $referArray(%B)]] {
#		if {[string equal -nocase {DC} $tagType] && $JC} {lappend outputList DC.relation.ispartof [set $referArray(%B)]}	;# commented by GJFB on 2023-08-31
		if {[string equal -nocase {DC} $tagType] && [string equal {SEO} $dcType]} {lappend outputList DC.relation.ispartof [set $referArray(%B)]}	;# added by GJFB on 2023-08-31 - SEO only
		if {[string equal {HP} $tagType] && $J} {lappend outputList citation_journal_title [set $referArray(%B)]}
		if {[string equal {HP} $tagType] && $C} {lappend outputList citation_conference_title [set $referArray(%B)]}
	}

# issn
	if ![string equal {} $issn] {
		if [string equal {HP} $tagType] {lappend outputList citation_issn $issn}
	}

# isbn
	if ![string equal {} $isbn] {
		if [string equal {HP} $tagType] {lappend outputList citation_isbn $isbn}
	}

# volume
	if ![string equal {} [set $referArray(%V)]] {
		if {[string equal {HP} $tagType] && $JC} {lappend outputList citation_volume [set $referArray(%V)]}
	}
	
# number
	if ![string equal {} [set $referArray(%N)]] {
		if {[string equal {HP} $tagType] && $JC} {lappend outputList citation_issue [set $referArray(%N)]}
	}
	
# page
	if ![string equal {} [set $referArray(%P)]] {
		if {[string equal {HP} $tagType] && $JC} {
			if [regexp {(.*) *- *(.*)} [set $referArray(%P)] m fpage lpage] {
				lappend outputList citation_firstpage $fpage
				lappend outputList citation_lastpage $lpage
			} else {
				lappend outputList citation_firstpage [set $referArray(%P)]
			}
		}
	}
	
# publisher/university/institution
	if ![string equal {} [set $referArray(%I)]] {
		if [string equal -nocase {DC} $tagType] {lappend outputList DC.publisher [set $referArray(%I)]}
		if {[string equal {HP} $tagType] && $T} {lappend outputList citation_dissertation_institution [set $referArray(%I)]}
		if {[string equal {HP} $tagType] && $R} {lappend outputList citation_technical_report_institution [set $referArray(%I)]}
		if {[string equal {HP} $tagType] && !$T && !$R} {lappend outputList citation_publisher [set $referArray(%I)]}
	}

# reportnumber
	if ![string equal {} $reportnumber] {
		if {[string equal {HP} $tagType] && $R} {lappend outputList citation_technical_report_number $reportnumber}
	}
		
# identifier
	if {[string equal {HP} $tagType] && [string equal -nocase {.pdf} [file extension $targetfile]] && ![string equal {External Contribution} $contenttype]} {lappend outputList citation_pdf_url http://$localSite/col/$repository/doc/$targetfile}
	if [string equal -nocase {DC} $tagType] {
		if [string equal {URL} $identifierType] {
# URL
			if ![string equal {} $size] {
# identifier - rep
				if ![string equal {} $repository] {
					lappend outputList DC.identifier http://urlib.net/$repository	;# added by GJFB on 2010-11-13
				}
# identifier - ibip or ibin
				if ![string equal {} $identifier] {
					lappend outputList DC.identifier http://urlib.net/$identifier	;# added by GJFB on 2018-04-09
				}
			}
		} else {
# IBI
			if ![string equal {External Contribution} $contenttype] {
# not External Contribution (SIBGRAPI case)
				if [string equal {} $identifier] {
					lappend outputList DC.identifier ibi:$repository	;# added by GJFB on 2023-02-22
				} else {
					lappend outputList DC.identifier ibi:$identifier	;# added by GJFB on 2023-02-22
				}
				if {[string equal -nocase {.pdf} [file extension $targetfile]] && ![string equal {External Contribution} $contenttype]} {lappend outputList DC.identifier http://$localSite/col/$repository/doc/$targetfile}
			}
			if ![string equal {} $doi] {
# doi
				lappend outputList DC.identifier doi:$doi
			}	
		}
	}
		
# subject - keywords
	if [string equal -nocase {DC} $tagType] {
		if ![string equal {} $keywords] {
#				lappend outputList "$tabulation				<dc:subject>[Convert $keywords]</dc:subject>"	;# commented by GJFB on 2018-04-09
			regsub {\.$} $keywords {} keywords2	;# added by GJFB on 2018-04-09
			foreach keyword [split $keywords2 {,}] {	;# added by GJFB on 2018-04-09 after Claudia talk
				lappend outputList DC.subject [join $keyword]
			}
		}
	}
	if [string equal {HP} $tagType] {
		if ![string equal {} $keywords] {
			regsub {\.$} $keywords {} keywords2	;# added by GJFB on 2018-04-09
			foreach keyword [split $keywords2 {,}] {	;# added by GJFB on 2018-04-09 after Claudia talk
				lappend outputList citation_keywords [join $keyword]
			}
		}
	}
	
# abstract
# if 0 #	;# if commented by GJFB on 2023-05-25
## commented by GJFB on 2012-12-04 - request from Roberto Novaes Rocha (BDTD) - idem mtd2-br
if [string equal {DC} $tagType] {	;# if added by GJFB on 2023-05-25 - required to create a well formed thisInformationItemHomePage.html file
# not OAI
	regsub -all {&} $abstract {\&amp;} abstract
	regsub -all {<} $abstract {\&lt;} abstract
	regsub -all {>} $abstract {\&gt;} abstract
}

# description
	if [string equal -nocase {DC} $tagType] {
		if ![string equal {} $abstract] {
			lappend outputList DC.description $abstract
		}
		if ![string equal {} $issn] {
			lappend outputList DC.description [join [list issn: $issn]]
		}
		if ![string equal {} $isbn] {
			lappend outputList DC.description [join [list isbn: $isbn]]
		}
		if ![string equal {} [set $referArray(%V)]] {
			lappend outputList DC.description [join [list $field::conversionTable($referArray(%V)): [set $referArray(%V)]]]
		}
		if ![string equal {} [set $referArray(%N)]] {
			lappend outputList DC.description [join [list $field::conversionTable($referArray(%N)): [set $referArray(%N)]]]
		}
		if {![string equal {} $referArray(%P)] && ![string equal {} [set $referArray(%P)]]} {
#				lappend outputList description [list $field::conversionTable($referArray(%P)): [Convert [set $referArray(%P)]]]
			lappend outputList DC.description [join [list $field::conversionTable($referArray(%P)): [set $referArray(%P)]]]
		}
	}
	
# type
	array set openAIRETable $env(OPENAIRE_LIST_FOR_ARRAY)	;# added by GJFB on 2023-08-04
	
	if [string equal -nocase {DC} $tagType] {
		if {0 && [string equal {Data} $referencetype]} {	;# commented by GJFB on 2023-08-13 - now OpenAIRE
			lappend outputList DC.type data
		} elseif {0 && [string equal {Computer Program} $referencetype]} {	;# commented by GJFB on 2023-08-13 - now OpenAIRE
			lappend outputList DC.type software
		} elseif {[string equal {Thesis} $referencetype]} {	;# added by GJFB on 2023-08-04
			switch -regexp $thesistype Dissertação {
				lappend outputList DC.type masterThesis	;# added by GJFB on 2023-08-04
			} Tese {
				lappend outputList DC.type doctoralThesis	;# added by GJFB on 2023-08-04
			} default {
				lappend outputList DC.type text
			}
		} else {
#			lappend outputList DC.type text	;# commented by GJFB on 2023-08-04
			lappend outputList DC.type $openAIRETable($referencetype)	;# added by GJFB on 2023-08-04
		}
	}

# language
	if ![string equal {} $language] {
		if [string equal -nocase {DC} $tagType] {lappend outputList DC.language $language}
		if [string equal {HP} $tagType] {lappend outputList citation_language $language}
	}
	
if 0 {
# agency
	if ![string equal {} $agency] {
		lappend outputList description.sponsorship $agency
	}
}

# rights
	if [string equal -nocase {DC} $tagType] {
		lappend outputList DC.rights [list Copyright information available at source Archive]
	}

	return $outputList
}

# CreateMetadataTags - end
# ----------------------------------------------------------------------
# FileExists
# added by GJFB on 2024-03-09
# tested but not used

proc FileExists {fileName} {
# runs with post
	global homePath
	
	file exists $homePath/$fileName
}

# FileExists - end
# ----------------------------------------------------------------------
# TestSentinelProcess
# added by GJFB on 2024-03-09
# used in cgi/mirror.tcl only
# returns 1 if the sentinel process is running
# returns 0 if the sentinel process is not running
# returns - if the sentinel state is indefined
#	known pid		sentinel running	conclusion
#		0					0				-
#		0					1				-
#		1					0				0
#		1					1				1  
    					
proc TestSentinelProcess {} {
# runs with post
	global homePath
	global URLibServiceRepository
	
	Load $homePath/col/$URLibServiceRepository/auxdoc/sentinelPID sentinelPID	;# stored in sentinel.tcl
#	if [string equal {} $sentinelPID] {return 0}	;# unknown pid - commented by GJFB on 2025-02-16
	if [string equal {} $sentinelPID] {return -}	;# unknown pid - added by GJFB on 2025-02-16
	return [expr ![catch {exec ps $sentinelPID}]]	;# 1 means that sentinel is running and 0 not
}

# TestSentinelProcess - end
# ----------------------------------------------------------------------
# ReturnArrayValueFromFile

if 0 {
	set namespacePrefix urn:doi
	ReturnArrayValueFromFile urlib.net/www/2025/09.08.04.08 namespacePrefixXresolverURLarray.tcl namespacePrefixXresolverURLarray $namespacePrefix
}

proc ReturnArrayValueFromFile {repository fileName arrayName inputValue} {
# runs with post
	global homePath

	source $homePath/col/$repository/doc/$fileName	;# set namespacePrefixXresolverURLarray
	
	if [info exists ${arrayName}($inputValue)] {
		return [set ${arrayName}($inputValue)]
	}
}

# ReturnArrayValueFromFile - end
# ----------------------------------------------------------------------