# Utilities1
# Copyright for URLibService (c) 1995 - 2019,
# by Gerald Banon. All rights reserved.

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

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

# ----------------------------------------------------------------------
# DirectoryContent
# build a list of all the files contained in a directory and its childs
# bound == {} means no limit to the number of files
# otherwise $bound is the maximum number of files returned
# Example:
# DirectoryContent docContent $docPath $docPath

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
		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 in 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
		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 $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 {$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 in 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 in 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 submit.tcl), and urlibScript/getWordOccurrence.tcl only

proc Store {
	varName filePath {translation auto} {nonewline 0} {access w} {force 0}
	{encodingName {}} {trialNumber 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 {$trialNumber < 10} {
			if [info exists x] {unset x}
			after 100 {set x 1}; vwait x	;# wait 100 ms
			incr trialNumber
#			Store $varName $filePath $translation $nonewline $access $force $trialNumber
			Store var $filePath $translation $nonewline $access $force $encodingName $trialNumber	;# fixed by GJFB in 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 $nonewline {
			puts -nonewline $fileId $var
		} else {
			puts $fileId $var
		}
		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 in 2018-12-25
			Load $colPath/col/$rep/service/type contentType	;# added by GJFB in 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

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

# 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
# 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 200 "set x$clicks 1"	;# 100 ms - after 100 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
			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 0 {
				while {![info exist y$clicks]} {
					set x 0; after 10 {set x 1}; vwait x
				}
} 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
}
			if [set y$clicks] {
# time-out
				close $sock
				return -code error -errorinfo "reading time out at $eval(server,$sock)"
#				return -code return -errorinfo {reading time out}
			}
			unset y$clicks	;# added by GJFB in 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 in 2013-07-19
#		if [info exists eval] {unset eval}	;# added by GJFB in 2013-07-19 - free memory - commented by GJFB in 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 in 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 in 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 in 2010-07-09
## returning to old code - done by GJFB in 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)
				set async2 1
			}
		}
	} else {
		set async2 0
	}
# puts $site
# 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 in 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 in 2012-12-29
		set log "\n\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] Execute (5): catch returns --$output-- while executing: \"Submit $localURLibClientSocketId $command $async2 $clicks\"\n"
		Store log $homePath/@errorLog auto 0 a
#		puts $log
		return	;# if time out, return empty
	}
	close $localURLibClientSocketId
# Store localURLibClientSocketId C:/tmp/bbb.txt auto 0 a
# puts OK
	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 in 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
# ----------------------------------------------------------------------
# CompareYearKeyTitle
# created by GJFB in 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 in 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 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

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}}
} {
	global env
	global cgi
	global searchResultList
	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 {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 {Do you have an audiovisual material? Submit it}	;# 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 {Available from:}
	global {Access in:}
	global {How to Make the Citation of this Document 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 emtpy 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 {work-in-progress}	;# used in CreateFullEntry only
	global {completed}	;# used in CreateFullEntry only
	global {slides}	;# used in CreateFullBibINPEEntry only
	global {Slides}	;# used in CreateFullBibINPEEntry only
	global {Translation by}	;# used in CreateFullBibINPEEntry only
	global {source Directory Content}
	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 extraCode
	
# 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
	
	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
		}
	}

# puts [CallTrace]

# 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)}
	}

# 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
	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}
	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(cssfileurl)] {lappend requestURI cssfileurl=$cgi(cssfileurl)}
	if [info exists cgi(codedpassword1)] {lappend requestURI codedpassword1=$cgi(codedpassword1)}
	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
	if {[info exists cgi(choice)] && [regexp {^(full|brief)$} $cgi(choice)]} {
# for 3 subst
		regsub -all {\[} $requestURI {\\\\\\\\\\\\\[} requestURI	;# [ -> \\\\\\\[
		regsub -all {\]} $requestURI {\\\\\\\\\\\\\]} requestURI	;# ] -> \\\\\\\]
		regsub -all {\[} $requestURI3 {\\\\\[} requestURI3	;# [ -> \\\[
		regsub -all {\]} $requestURI3 {\\\\\]} requestURI3	;# ] -> \\\]
	} else {
# for 2 subst
		regsub -all {\[} $requestURI {\\\\\[} requestURI	;# [ -> \\\[
		regsub -all {\]} $requestURI {\\\\\]} requestURI	;# ] -> \\\]
	}
# 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
	} 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 in 2010-09-09 (after an update, the similar list may be empty)
	}
	set output2 {}
	set i 0
# FOREACH
# puts [fconfigure stdout]
	foreach searchResult $searchResultList {
# puts 1
# set x 0; after 500 {set x 1}; vwait x	;# testing progressive loading
# 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 "<!-- [string repeat a 4096] -->"	;# to have the previous puts displayed
# 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)]
		set similarity $citationKey
# EXTRA
		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]
# 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 in 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 in 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 [subst [subst [subst $${top}Singular]]]]
				} else {
					if {$flag && ![regexp Recent $top]} {
# puts [subst $topForContinue]
						set output [subst [subst [subst $topForContinue]]]
					} else {
# puts [subst [set ${top}Plural]]
						set output [subst [subst [subst [set ${top}Plural]]]]
#						set output [subst $${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>
				}
			}
			set firstEntry 0
		}
# Header - end

# puts ${rep-i}<BR>
# puts [list --$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	;# ] -> \]
#				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 in 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
					} 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 in 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} - $entry --><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
}

# 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)

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 {; }}
} {
	global searchResultList
	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 extraCode
	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

# extra code for copying to clipboard
	if {[info exists cgi(choice)] && [string equal {brief} $cgi(choice)]} {
		set extraCode {
			<script language="JavaScript">
				var clip = null;
				function init() {
					clip = new ZeroClipboard.Client();
					clip.setHandCursor(true);
				}
				function move(elt) {
					clip.setText(document.getElementById(elt.id).innerHTML);
					if (clip.div) {
						clip.receiveEvent('mouseout', null);
						clip.reposition(elt.id);
					} else {
						clip.glue(elt.id);
					}
					clip.receiveEvent('mouseover', null);
				}
	       	</script>
		}
	} else {
		set extraCode {}
	}		
	
# 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 in 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 in 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]

# 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--

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
}

# 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 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
		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 in 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 in 2017-07-12 - return empty - used in DisplayNumber

						} else {
							error "CreateOutput: unexpected searchResult value: $searchResult\nthe query was: <$query>."	;# commented by GJFB in 2017-01-01 for testing
#							global replyName	;# added by GJFB in 2017-01-01 for testing - set in MultipleExecute
#							global $replyName	;# added by GJFB in 2017-01-01 for testing - set in MultipleExecute
#							set reply [set $replyName]	;# added by GJFB in 2017-01-01 for testing
#							unset $replyName	;# added by GJFB in 2017-01-01 for testing - previously in MultipleExecute
#							global replyTrace	;# added by GJFB in 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 in 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]
# 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 in 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]
# 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
		}
# 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 [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--
# 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 in 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 in 2010-11-02
				} else {
# by stamp (metadatalastupdate)
					set searchResultList [lsort -command CompareStamp $searchResultList]
				}
			}
			set searchResultList [lrange $searchResultList 0 [expr $maximumNumberOfEntries - 1]]
			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
			if $header {
#				if {[info exists cgi(choice)] && $cgi(choice) == "fullbibtex"}
				if {[info exists cgi(choice)] && [regexp {fullXML} $cgi(choice)]} {
					puts </PRE>
					puts </FONT>
				}
#				puts "<TABLE WIDTH=100%><TR><TD class=displayTD>"
				puts [CreateReturnButton <HR> $path$col/$languageRep2/doc/mirror {} $display $Return {} {} {} {} 1]
#				puts "</TD></TR></TABLE>"
				puts <BR></BODY></HTML>
				return
			} else {
				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 in 2016-03-14
				set searchResultList [lsort -index 5 $searchResultList]	;# added by GJFB in 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 in 2016-03-14	
## by date.key - used in MountHTMLPage only
#						set searchResultList [lsort -command CompareDateKey $searchResultList]	;# added by GJFB in 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 in 2018-02-26
# by date.year.key - used in MountHTMLPage only
						set searchResultList [lsort -command CompareDateYearKey $searchResultList]	;# added by GJFB in 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 in 2018-02-26
					} elseif {[info exists cgi(sort)] && [regexp {^year.key.title$} $cgi(sort)]} {
# by year.key.title - 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 in 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 in 2013-10-15 - used by UpdateBody in displaydoccontent.tcl to have the entries sorted by key (and title if the keys are the same)
					} else {
# by key
# puts --$searchResultList--<BR>
#						set searchResultList [lsort -command CompareKey $searchResultList]
						set searchResultList [lsort -dictionary -index 1 $searchResultList]	;# -dictionary added by GJFB in 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)
		}
	}
	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 {}
		}
	}
	if $header {
#		if {[info exists cgi(choice)] && $cgi(choice) == "fullbibtex"}
		if {[info exists cgi(choice)] && [regexp {fullXML} $cgi(choice)]} {
			puts </PRE>
			puts </FONT>
		}
# 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
				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]
			}
#			puts "</TD></TR></TABLE>"
		}
#		puts $fontTag2</BODY></HTML>
		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
	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 $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>}
	return $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
}

# 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

#	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.language)]} #
#		set languageButton $cgi(ibiurl.language)	;# ibiurl.language 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] || [string equal {} $parentRepList]} {
# 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=\"#DDDDDD\">
		<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
			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
			set submissionFormLanguage $language
			set submissionFormLanguageRep $languageRep
		}
	} else {
# there is no submission form repository
		set submissionFormRep $mirrorHomePageRep
		set submissionFormLanguage $language
		set submissionFormLanguageRep $languageRep
		set submissionFormFirstLanguageRep $languageRep	;# added by GJFB in 2013-06-06 - needed to display the Mirror Home Page Construction Warning
	}

	close $localURLibClientSocketId

	if {$language == "" || $submissionFormLanguage == ""} {
		puts {Content-Type: text/html}
		puts {}
		puts "
<HTML>
	<HEAD>
		<TITLE>Mirror Home Page Construction Warning</TITLE>
	</HEAD>
	<BODY BGCOLOR=\"#DDDDDD\">
		<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
# if ReturnURLPropertyList returns an empty list then ReturnURLPropertyList2 tries in the scope of all sites
# from the URLib Server
# 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)
# 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)

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

proc ReturnURLPropertyList2 {criterionList useURLibServerFlag {useLocalServerOnlyFlag 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

if 0 {
	puts {Content-Type: text/html}
	puts {}
	puts [CallTrace]
}
# set clicks [clock clicks]
# puts $clicks-$criterionList<BR>
# puts $useURLibServerFlag

# set useURLibServerFlag 1	;# for testing
#	if $useURLibServerFlag 	# ;# commented by GJFB in 2017-02-20
	if {$useURLibServerFlag && !$useLocalServerOnlyFlag} { 	;# added by GJFB in 2017-02-20
		set urlPropertyList {{}}
	} else {
		set urlPropertyList [ReturnURLPropertyList $criterionList]	;# returns from the current site - the current site may be the urlib site
# 	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 in 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 in 2017-02-20
# puts $useLocalServerOnlyFlag
	if {[string equal {{}} $urlPropertyList] && !$useLocalServerOnlyFlag} { 	;# added by GJFB in 2017-02-20
# not found in the current site or deleted
# puts "not found in the current site or deleted"

#		if [info exists env(IP_ADDR)] #	;# commented by GJFB in 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)
		} else {
# the calling procedure is not a cgi script
		}
		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
				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

proc ReturnURLPropertyList {criterionList} {
	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

# 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 $criterionList2
#	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)
# 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 GetURLPropertyList
# criterionList value is described in ResolveIBI

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} {
	global homePath
	global serverAddress
	global loCoInRep
	global printFlag	;# set in Get and Get- only
	global loBiMiRep
	global serverAdministratorAddress	;# banon@dpi.inpe.br - set in CreateConfigurationFiles or Get- or Get
	
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

	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 in 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 in 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 in 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}
			} else {
# optimized list of sites
				set command [list list GetOptimizedListOfSites $ibi $mirror $administratorCodedPassword]
# MULTIPLE SUBMIT
				foreach {optimizedListFlag siteProtocolList} [MultipleExecute [list $serverAddress] $command 0] {break}	;# scenario 0
				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"
					error [StoreLog {alert} {FindURLPropertyList (1)} $log]	;# added by GJFB in 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"
			error [StoreLog {alert} {FindURLPropertyList (2)} $log]	;# added by GJFB in 2018-05-15
		}
	}

# puts --$scanAllArchivesFlag--
# puts --$optimizedListFlag--
# puts --$siteProtocolList--
# => --{{gjfb.home 19050} J8LNKB5R7W/3FTRH3S USP}--
# set xxx --$siteProtocolList--
# Store xxx C:/tmp/bbb.txt auto 0 a

	set listOfibiProperties [FindURLPropertyList2 $criterionList2 $siteProtocolList $scanAllArchivesFlag]

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}
		set listOfibiProperties [FindURLPropertyList2 $criterionList2 $siteProtocolList $scanAllArchivesFlag]
	} 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 in 2018-05-27
		set message [Execute $serverAddress [list UpdateIBIToArchiveServiceArray $ibi $archiveServiceIBI $optimizedListOfSitesFailedFlag $administratorCodedPassword]]	;# added by GJFB in 2018-05-27
		
# 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

proc FindURLPropertyList2 {criterionList2 siteProtocolList scanAllArchivesFlag} {
	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 OK
}

# 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

	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 in 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 in 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 in 2013-07-07	
		regsub -all {=} $value {%3d} value	;# added by GJFB in 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 in 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 1]
# 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 in 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 in 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 in 2013-08-15
#		set siteRep [list $urlPropertyArray(archiveaddress) $urlPropertyArray(repository) $metadataFieldList]	;# added by GJFB in 2014-04-03 - ReturnHTTPHost not needed (called in GetURLPropertyList)
		set siteRep [list $site $repository $metadataFieldList]	;# added by GJFB in 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 in 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

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 doesn'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

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

# >>> 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--
	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

# 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


	Load $homePath/col/$URLibServiceRepository/auxdoc/nslookupMessage fileContent
# puts $fileContent
#	regsub -all {\n} $fileContent { } itemList	;# commented by GJFB in 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 in 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 in 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 in 2014-11-30 - Name (Nome) might be without dot (example: gjfb)  - added by GJFB in 2015-01-27 - \\:\\w is for IPv6
	}
#	if [regexp {Non-authoritative answer:} $fileContent] {
#		return [list {} {}]
#	}
	set fullServerName [lindex $itemList2 2]
	set ip [lindex $itemList2 3]
	if ![string equal {} $ip] {
		set ip [lindex $itemList2 end]	;# added by GJFB in 2015-01-27 - it is assumed that IPv4 is at the end of the "Addresses:"
	}
#	if [string equal {} $ip] {
#		return [list {} {127.0.0.1}]
#	}

#	if {$pingFlag && $tcl_platform(platform) == "windows"} #	;# commented by GJFB in 2019-04-02
	if {$tcl_platform(platform) == "windows"} {	;# added by GJFB in 2019-04-02 - pingFlag should control ping from unix only
		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 in 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 returned
# the wordListLength value is an integer or the empty value
# if wordListLength is emtpy, then all the words are returned

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

	if ![info exists homePath] {
		set homePath $env(DOCUMENT_ROOT)
	}
	global wordOccurrenceList	;# used in MultipleSubmit
	set log [clock format [clock seconds]]
	Store log $homePath/col/$currentRep/doc/@log auto 0 a
	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
	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 {nothing done: numberOfSites != numberOfSatisfiedQueries}
			Store message $homePath/col/$currentRep/doc/@log auto 0 a
			return
		}		
	}
	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, 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 in 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 in 2018-02-12
		if $flag {	;# added by GJFB in 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]="(http://[^/]+/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 are 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

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 in 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 in 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 in 2018-06-28 (see CallTrace)
		set shortenFlag [string equal {OpenSession} $id]
		StoreLog {notice} {WaitQueue} [CallTrace $shortenFlag]	;# added by GJFB in 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)

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
# 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)
# 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
	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
# puts --$var--
##		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
	}
	if [file exists $fileName] {
		return 1
	} else {
		if [catch {open $fileName w} fileId] {
# for example, permission denied
			return 1
		}
#		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"}
		puts $fileId $fileContent 
		close $fileId
		return 0
	}
}

if 0 {
source utilities1.tcl
EnterQueue 123
}

# EnterQueue - end
# ----------------------------------------------------------------------
# LeaveQueue
# id not used in this procedure

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 in 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 in 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 in 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
# 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 stamp
# examples of siteFieldName are site 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

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}
} {

#	global env
	global cgi
#	global currentRep	;# mirror
	global language languageRep1 languageRep2

#	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 [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 ![info exists cgi(codedpassword1)] {set cgi(codedpassword1) {}}
	if $displayHiddenRecord {
		set codedPassword1 $cgi(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]
}

# 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 

	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 
		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:
# 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 AcknowlegeArchive (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 symmetrickey, 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
	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 in 2018-12-31
			regsub -- {-.*$} [lindex $session 0] {} sessionTime ;# added by GJFB in 2018-12-31 - now the session time is in milliseconds
			set seconds [string replace $sessionTime end-2 end]	;# drop the 3 last digits
			if {$seconds > $pastTime} {
				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 in 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 in 2018-12-31
		after 100	;# delay of 100 milliseconds
#		set currentTime [clock seconds]	;# commented by GJFB in 2018-12-31
		set currentTime [clock milliseconds] ;# added by GJFB in 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
		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]
	Store randomSeed $homePath/col/$randomSeedRepository/auxdoc/randomSeed
	return $randomSeed
}

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
	SortRandomNumber
}

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

proc CreateRandomPassword {{passwordLength 8}} {
	regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} randomPassword
	set numberLetterist {
		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} $numberLetterist {
		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 AcknowlegeArchive 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 in 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 in 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
		
	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
# examples of \documentclass line in a .tex file for document class capture:
# \documentclass[brazilian,SemFolhaAprovacao]{http://urlib.net/iconet.com.br/banon/2008/03.25.01.19/tdiinpe}
# %\documentclass[brazilian,SemFolhaAprovacao]{http://urlib.net/iconet.com.br/banon/2008/03.25.01.19/tdiinpe}
# no other commented \documentclass line with a different class file name must be used before this line
# the second example must be used when @schedule.tcl doesn't exist
# in this case, the .tex file must contain the uncommented line:
# \documentclass[brazilian,SemFolhaAprovacao]{tdiinpe}

# example:
# %\documentclass[brazilian,SemFolhaAprovacao]{http://urlib.net/iconet.com.br/banon/2008/03.25.01.19/tdiinpe}
# \documentclass[brazilian,SemFolhaAprovacao]{tdiinpe}

# in both examples, the .tex file in the current repository is updated from the Web before TeX compilation
	if [regexp -nocase {\.tex$} $path] {
		set serverName {urlib.net}
#		set serverName {banon-pc3.dpi.inpe.br}
		set backSlash {}
		if {$numberOfSubstitutions == 1} {set backSlash {\\}}
# puts {Content-Type: text/html}
# puts {}
# puts $fileContent
# puts [regexp "(^|\[^%\])$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m x attribute documentClassURL documentClass]
# puts [regexp "%?$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m attribute documentClassURL documentClass]
#		if [regexp "(^|\[^%\])$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m x attribute documentClassURL documentClass] #
		if [regexp "%?$backSlash\\\\documentclass(\[^\\{\]*)\\{(http://$serverName/\[^/\]+/\[^/\]+/\[^/\]+/\[^/\]+/(\[^\\}\]+))\\}" $fileContent m attribute documentClassURL documentClass] {
# puts [list $documentClassURL $documentClass]
# Capture the document class
			package require http
			if [catch {http::geturl [ConvertURLToHexadecimal $documentClassURL.cls]} token] {
# 1
				set log [list {CreateTclPage (1): url not found} $documentClassURL.cls $token]
				Store log $errorLogPath auto 0 a
			} else {
# Store token $errorLogPath auto 0 a
# set code [http::code $token]
# Store code $errorLogPath auto 0 a
				if ![regexp {302 Found} [http::code $token]] {
					set log [list {CreateTclPage (2): url not found} $documentClassURL.cls [http::code $token]]
# 2
					Store log $errorLogPath auto 0 a
				} else {
# puts OK
					set data [http::data $token]
# <a href="http://banon-pc2/col/iconet.com.br/banon/2008/03.25.01.19/doc/tdiinpe.cls">
# Store data $errorLogPath auto 0 a
					regexp {[hH][rR][eE][fF]="(http://[^/]+/col/[^"]+)"} $data m redirectedURL	;# "
					set fileId [open $homePath/col/$thisRepository/doc/$documentClass.cls w]
#					if [catch {http::geturl [ConvertURLToHexadecimal $redirectedURL] -channel $fileId} token] #	;# doesn't work anymore in Windows XP - symbols like © are not written properly in the channel, they are displayed using ? (see for example the header of tdiinpe.cls)
# option -binary 1 solves the channel problem - added bt GJFB in 2010-11-09
					if [catch {http::geturl [ConvertURLToHexadecimal $redirectedURL] -binary 1 -channel $fileId} token] {
# 3
						set log [list {CreateTclPage (3): url not found} $documentClassURL.cls $token]
						Store log $errorLogPath auto 0 a
					} else {
						if ![regexp {200 OK} [http::code $token]] {
# 4
							set log [list {CreateTclPage (4): url not found} $redirectedURL [http::code $token]]
							Store log $errorLogPath auto 0 a
						}
					}
					close $fileId
				}
				http::cleanup $token
			}
# Capture the document class - end
			regsub {\[} $attribute {\[} attribute
			regsub {\]} $attribute {\]} attribute
			regsub "\\\\documentclass($attribute)\\{$documentClassURL\\}" $fileContent "\\documentclass\\1{$documentClass}" fileContent
		}
		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
		
		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) - 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 {}}

	#	LoadService $thisRepository userName userName 1 1
#	if [string equal {administrator} $userName] {
#		set safeFlag 0
#	} else {	
#		set safeFlag [expr [clock scan "Mar 16, 2008"] < [file mtime $path]]	;# becomes safe after 2008-03-16
		set safeFlag [expr [clock scan "Mar 16, 2008"] < [file mtime $targetFileAbsolutePath]]	;# becomes safe after 2008-03-16 - added by GJFB in 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
	set safeFlag 0
	puts {Content-Type: text/html}
	puts {}
} 
 set safeFlag 1	;# let turn to 0 when using the Store command
# 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

	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 $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 $loCoInRep $loBiMiRep $clientServerAddressWithIP $progressKey $applicationNameForReverseEngineering $applicationRuningTime $applicationFileName]
# 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 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 loCoInRep loBiMiRep clientServerAddressWithIP progressKey applicationNameForReverseEngineering applicationRuningTime applicationFileName} [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 in 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 in 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 in 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 in 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] {
# 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 in 2017-07-15 (was in DisplayNumber)
				Store log $errorLogPath auto 0 a	;# added by GJFB in 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]
		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
# ----------------------------------------------------------------------
# CreateAlternatePath
# 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
# puts $path
# puts $directory
	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 in 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 CreatePage and Submit
# path must be absolute
# >>> 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	;# used by CreateTclPage
	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

	set col ../../../../..
# set xxx 1
# Store xxx C:/tmp/bbb.txt binary 0 a

## 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 in 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 (final of path)
# doc/tclPage.txt (final 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

# 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 in 2015-08-25 - now the current version is duplicated in a file which 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
				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}
						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 [file exists $homePath/col/$thisRepository/doc/@schedule.tcl] {
						Store fileContent $alternatePathWithoutExtension.tex
					}
				}
				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 in 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 in 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
			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

	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
# Make glerc file
# useful when using copy of the gle repository
			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
			"
			regsub {bin/gle.exe} $glePath {glerc} glercPath
			Store glercFileContent $glercPath
# Make 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 in 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)

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 in 2011-10-15 - \RequirePackage{textcomp}	% usado para \texttildelow, produces an error, nevertheless the right pdf is created
		catch {exec $pdflatexPath $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>$message</PRE>
				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
		if [regexp "No file $alternateTailWithoutExtension.bbl" $logFileContent] {
# EXEC bibtex
if 0 {
# commented by GJFB in 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 in 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
			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 in 2014-07-14 - cannot be an absolute path with MiKTeX 2.9
#			if [catch {exec $makeindexPath -q $targetFile} message] #	;# commented by GJFB in 2019-02-17 - doesn't work
			set fileName [file rootname [file tail $targetFile]]	;# added by GJFB in 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
			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 $alternatePath
# => c:/gerald/urlib 2/col/iconet.com.br/banon/2008/01.20.16.42/doc/@LaTeX1.pdf
	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] {
					set timePeriod 1
				} 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] {
					if ![info exists timePeriod] {set timePeriod 1}
				} else {
					if ![info exists timePeriod] {set timePeriod 0}
				}
				if ![info exists numberOfSubstitutions] {set numberOfSubstitutions 2}
				if ![info exists storeTclPage] {set storeTclPage 1}
			}
			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
			}
		} 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 [file exists $dirName/mirrorHomePage.html] {
				set timePeriod 1
			} else {
				set timePeriod 0
			}
		}
		if ![info exists numberOfSubstitutions] {set numberOfSubstitutions 2}
		if ![info exists storeTclPage] {set storeTclPage 1}
		return 1
	}
	return 0
}

# TestForTclPageUpdate - end
# ----------------------------------------------------------------------
# StoreDefaultSchedule
# used in TestForTclPageUpdate 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 in 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] {
		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 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 in 2011-09-09
	regsub -all {#@@#} $text {]]} text	;# added by GJFB in 2011-09-09
	regsub -all {#!#} $text {[} text
	regsub -all {#@#} $text {]} text
	return $text
}

# UnProcessBrackets - end
# ----------------------------------------------------------------------
# PutDocumentOnClipboard
# used by Submit and StoreRepository
# 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
# 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)
# 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
} {
	upvar $userfileName userfile
	
	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
				set fileName [file tail $remotePath]
				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]]
			}
			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 in 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 in 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

proc CreateHiddenInput {varName {deposit 0}} {
	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 ![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)
# eMailAddress is the e-mail address of the userName (if any)
# sessionTime value are miliseconds - added by GJFB in 2019-01-16

proc StorePassword {userName password {eMailAddress {}} {sessionTime {}}} {
	global homePath
	global htpasswdPath
	global loCoInRep
	global env	;# for cgi script
#	global environmentArray	;# for other script (StorePassword2 used by processMail) - processMail is not used anymore - GJFB in 2010-10-16
	global environmentArray	;# for other script (StorePassword2 used by cgi/createNewPassword in iconet.com.br/banon/2009/05.17.20.29)

# 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
# puts OK
if 0 {
# commented by GJFB in 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 in 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 in 2013-05-28
	regsub -all {\s+} $string { } string	;# added by GJFB in 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 in 2012-02-27 - Banon 1945.05 -> Banon 1945. 05
#		regsub -all {\.([^ ,\d])} $newName {. \1} newName	;# added by GJFB in 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}
	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]
	lappend fieldList [list $fieldName $line.]	;# add a period
}

# 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 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 in 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 in 2011-02-08
				set dataSet {}
				foreach {input output} $var {
					lappend dataSet [list $input $output]
				}
				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]
				}
			} elseif {$inputFormat == "unsortedlist"} {
# list outputFormat - unsortedlist inputFormat
# option added by GJFB in 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 {
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 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
# =>
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
	
	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
	}
}

# SourceWithBackup - end
# ----------------------------------------------------------------------
# StoreArrayWithBackup
# example: StoreArrayWithBackup localCollectionPasswordArray $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl w list array 1
# stores in:
# $col/$loBiMiRep/auxdoc/localCollectionPasswordArray.tcl and
# $col/$loBiMiRep/auxdoc/localCollectionPasswordArrayBackup.tcl
# 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]
# }
	
	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
}

# 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

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

# 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 {}
	}
#	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 and ReviewAssignment
# returnMessage values are 0 or 1
# 1 means to return "nothing found" message if searchResultList is emtpy 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 ...}
## 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 in 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 in 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 in 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 host name 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 host name 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 in 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 in 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 in 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 sci script)
											;# Misc,author -> Misc,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 in 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
# 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
# join [lrange [split {%T Tt \& tt}] 1 end] => Tt \& tt
#		set fieldValue [lrange $field 1 end]	;# doesn't preserve backslash
		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 miliseconds - added by GJFB in 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
	
	set password1 $cgi(codedpassword1)
# puts [list CheckPassword $cgi(username) --$password1--]
# puts --$serverAddressWithIP--
	set command [list list CheckPassword $cgi(username) $password1]	;# seek 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."}
	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
		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 in 2018-06-10 - this command ia already in Convert
#		regsub -all {<} $fieldValue {\&lt;} fieldValue	;# commented by GJFB in 2018-06-10 - this command ia already in Convert
#		regsub -all {>} $fieldValue {\&gt;} fieldValue	;# commented by GJFB in 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 (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 in 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 - 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 in 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 in 2016-06-07
#		if {[regexp {[[:alpha:]]|<|>|¦| |°|\[|\]|\{|\}} $character] && ![regexp {[a-zA-Z]} $character]} #	;# added by GJFB in 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 in 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 in 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 in 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 ¦ 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 ¦ 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
		set fileContent \
"<HTML>
<HEAD>
<TITLE>Redirection to the Bibliographic Mirror</TITLE>
<META HTTP-EQUIV=\"Refresh\" CONTENT=\"0; URL=http://[ReturnHTTPHost]/rep-/$loBiMiRep?ibiurl.requiredsite=$localSite2\">
</HEAD>
<BODY>
</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
# 6. col/$submissionFormRep/auxdoc/displayControl.tcl

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
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]--
# => ----	
	
# 3. -> 2. col/$submissionFormRep/doc/controlArray.tcl
# by GJFB in 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 ${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
# puts "SynchronizeRepository $submissionFormRep"
			SynchronizeRepository $submissionFormRep
		}
		
		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)--

# 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
	}

# 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
	}
	
if 0 {
# display for tracing sourced file name
	foreach name [lsort [array names sourcedFileArray]] {
		puts "$name $sourcedFileArray($name)<br>"
	}
}
	
# puts [info exists publishingYear]
	if {[info exists publishingYear] && [info exists attributeTableFileList]} {
		foreach attributeTableFile $attributeTableFileList {
			Source $attributeTableFile attributeTable	;# set attributeTable
		}
	}
# 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 in 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 in 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 in 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 in2015-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 in 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 in 2011-03-14
#		if {[string equal {} $outputFieldValue] && [string equal {author} $mappingDomainName]} #	;# commented by GJFB in 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 {}]
}		

# ReturnAttributeValue3 - 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 in 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 in 2010-10-23
			set quotient [expr entier($quotient / $baseSize)]	;# added by GJFB in 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 in 2010-10-23
		set output [expr $output + $bit * [DecimalPower 2 $i]]	;# added by GJFB in 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 in 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 in 2010-10-23
		set output [expr $output + $inverseDigitArray($digit) * [DecimalPower $baseSize $i]]	;# added by GJFB in 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} {
	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 in 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 in 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 in 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 in 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 in 2010-07-31
		set port [ConvertFromPortString $urlibPort $upperCaseOnly]	;# done by GJFB in 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 in 2010-07-31
		set port [ConvertFromPortString $urlibPort $upperCaseOnly]	;# done by GJFB in 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
		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 in 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 in 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 in 2010-07-31
		set urlibPort [ConvertToDecimal $codedPort $upperCaseOnly]	;# done by GJFB in 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 in 2010-07-31
		set urlibPort [ConvertToDecimal $codedPort $upperCaseOnly]	;# done by GJFB in 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
#	ConvertToRepository CBnmVX32PXQZeBBx/p8LKL
	ConvertToRepository CBnmVX32PXQZeBBx/p8N6G
	ConvertFromRepository iconet.com.br/banon/2001/02.10.22.55 1
#	ConvertToRepository MJ9PM2X5SNX3NV5GM6L/E6GTK8 1
	ConvertToRepository MJ9PM2X5SNX3NV5GM6L/E6H5HH 1
	
	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 in 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 in 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
	set metadataRep [Execute $serverAddressWithIP [list FindMetadataRep $submissionFormRepository]]
# puts --$metadataRep--
	SetFieldValue $serverAddressWithIP $metadataRep-0 {childrepositories}
# puts --$childrepositories--
	set mirrorRepCandidateList {}
	foreach childRep $childrepositories {
		set childMetadataRep [Execute $serverAddressWithIP [list FindMetadataRep $childRep]]
#		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}
		if [string equal {mirrorHomePage.html} $targetfile] {
# childRep is a mirror home page repository
			lappend mirrorRepCandidateList [lindex $childrepositories 0]	;# take the first mirror
		}
	}
# 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}
	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]
	}
#	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 in 2013-02-24 in order to continue executing CreateOptionListForCopyright even the communication with a server doesn't start
		if [string equal {} $repository] {
# conflicting server addresses (see SetFieldValue)
		} else {
			lappend optionList [list $citationkey [list [list "$repository&nbsp;" $repository]]]
		}
		if [string equal $repository $currentCopyrightRepository] {set flag 0}	;# don't add the current copyright repository
	}
	set optionList [lsort -unique -index 0 $optionList]
	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 and ComputeAccessRestrictionFlag
# 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 in 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 and Get
# 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 in 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 in 2018-03-10
		set fileList [ComputeFileList]	;# added by GJFB in 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 was iso coded - added by GJFB in 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 in 2018-03-10
			set fileList [ComputeFileList]	;# added by GJFB in 2018-03-10 - to capture the hidden files of Linux as well
			set fileList3 {}
			foreach file $fileList {
				if [file exists $file] {lappend fileList3 $file}
			}
			set fileList [concat $fileList2 $fileList3]
			encoding system utf-8
			set fileList [lsort -unique $fileList]
		} 
		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 in 2018-03-10 - similar code in DirectoryContent to capture in Linux, file name like .htaccess
# used in DirectorySize and DirectoryInfo
# modified by GJFB in 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 in 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 {}}} {
# runs with post and cgi script
	global homePath
	global URLibServiceRepository
	
	upvar enableTrace enableTrace
	
	if [string equal 1 $enableTrace] {	
		if [string equal {} $xxx] {
# 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
			}
 		}
#		puts $xxx
	 	Store xxx $homePath/col/$URLibServiceRepository/auxdoc/@traceProcedure 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 in 2018-03-09 - 51 B == 0.0 KiB and 52 B == 0.1 KiB
			set size2 [format "%.0f&nbsp;B&nbsp;&thinsp;&nbsp;&ensp;&ensp;" $size]	;# B
		} else {
			set size2 [format "%.1f&nbsp;KiB" [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

	set citationKeyRepository dpi.inpe.br/banon/1999/07.11.21.09
	if {[string equal {} $citationKey2] && \
	![string equal {} $creator] && \
	![string equal {} $title]} {
		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 [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 in 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 in 2013-12-10 - hidden metadata are searched
		} else {
			set query [list list GetMetadataRepositories {} 1 $searchExpression yes yes 0]	;# added by GJFB in 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
# ----------------------------------------------------------------------
# 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)

# proc CreateDirectoryContentList {currentRep dir {convertToUTF8 0} {targetFile {}}} #
proc CreateDirectoryContentList {
	currentRep dir {targetFile {}} {download download} {titleForDownload {}}
	{SLA SLA} {titleForSLA {}} {width 54}
} {
	global homePath
	global localSite
	global env
	
	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]
	}
	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 in 2014-08-06 - needed for GPRB thesis
	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)

	set i 0
	set j 0
	set lineList {}
	foreach file [lsort -dictionary $fileList] {
		if [regexp -nocase {\.php$} $file] {
			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>\
						[
							if [string equal {source} $folder] {
								regsub -all -- {\$} $file {\$} file2
								set file2
							} else {
								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 in 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] {
#									set file2 "<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>$file</B></A>"
									if [string equal {doc} $folder] {
										if [regexp {[^a-zA-Z0-9!@$¨&( )\-_=+´`{\[~^\]},.;]} [file tail $file]] {
											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>$file</B></A></span>"
										} 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;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\"><B>$file</B></A></span>"
										}
									} 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] {
										if [regexp {[^a-zA-Z0-9!@$¨&( )\-_=+´`{\[~^\]},.;]} [file tail $file]] {
											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\">$file</A></span>"
										} 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;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">$file</A></span>"
#											set file2 "<span style=\"white-space: nowrap;\"><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;<span style=\"white-space: nowrap;\"><A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">$file</A></span></span>"
											set file2 "<span style=\"white-space: nowrap;\"><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\">$file</A></span>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
										}
									} else {
										set file2 "<A HREF=\"[ConvertURLToHexadecimal http://$localSite/col/$currentRep/$folder/$file $convertToUTF8]\" TARGET=\"_blank\">$file</A>"
									}
								}
							}
						]\
					</TD>\
					<TD class=displayRightTD WIDTH=114>\
						[
							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 WIDTH=58>\
						[
							set x $propertyArray(size)
						]\
					</TD>\
				</TR>\
			"
			incr i
		}
	}
	return [list $lineList $j]
}

# CreateDirectoryContentList - end
# ----------------------------------------------------------------------
# ReturnFileProperties
# written by GJFB in 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 in 2015-01-15 when ReturnFileProperties is run from non cgi-script (when DirectoryMTime is called by ComputeVersionState called by CreateBriefEntry)
# puts "absoluteFilePath = --$absoluteFilePath--"
	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
	set absoluteFilePath8 [encoding convertto utf-8 $absoluteFilePath]
	set existenceFlag8 [file exists $absoluteFilePath8]

	foreach propertyName $propertyNameList {
		switch -exact $propertyName mtime {
			if $existenceFlag8 {
				set propertyValue [file mtime $absoluteFilePath8]
			} else {
				set propertyValue [file mtime $absoluteFilePath1]
			}
		} size {
			if $existenceFlag8 {
				set propertyValue [returnFileSize $absoluteFilePath8 $forceMegaByte]
			} else {
#				set propertyValue $existenceFlag8	;# for testing and displaying existenceFlag8
				set propertyValue [returnFileSize $absoluteFilePath1 $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
# ----------------------------------------------------------------------
# ParseIBIURL
# used in ReturnURLPropertyList, SelectAppropriateSimilar, Get and Get- only

proc ParseIBIURL {pathInfo queryString} {
	global localSite
# puts OK
# puts [CallTrace]	
	set pathInfo [string trim $pathInfo]	;# added by GJFB in 2011-05-03 - some paths may contain trailing blanks that are interpreted further (see Get-) as /
# puts $pathInfo
#	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] {
# casesensitive identifier from domain name
# ex.: ---X----X-Z--------Y--/-----
#			if [catch {ConvertToRepository $opaqueIBI} ibi] {error {syntax error}}
##			set ibiType rep
#			set ibiType ibin
			set ibi $opaqueIBI
		} elseif {[regexp -nocase {X} $opaqueIBI]} {
# caseinsensitive identifier from domain name
# ex.: ---X----X--V---------Y---/------
			if [catch {ConvertToRepository [string toupper $opaqueIBI] 1} ibi] {error {syntax error 1}}
#			set ibiType rep
		} elseif {[regexp {Z} $opaqueIBI]} {
# casesensitive identifier from ip
# ex.: ---------Z---/-------
# works only for the repositories created after 2010-07-31 (because of a change in ConvertFromCaseSensitiveIdentifier and ConvertToCaseInsensitiveIdentifier)
# there are no repositories having this identifier - for future use
##			set ibiType Zibip
#			set ibiType ibip
			set ipPortDateTime [ConvertFromCaseSensitiveIdentifier $opaqueIBI]
			set ibi [eval ConvertToCaseInsensitiveIdentifier $ipPortDateTime]
		} elseif {[regexp -nocase {W} $opaqueIBI]} {
# caseinsensitive identifier from ip
# ex.: ---------W---/-------
##			set ibiType Wibip
#			set ibiType ibip
			set ibi [string toupper $opaqueIBI]
		} else {
			error {syntax error 2}
		}
#	# elseif {[regexp {^/([^/]+/[^/]+/[^/]+/[^/+]+)(\+?)/?(.*)} $pathInfo m ibi plus filePath]} #
	} elseif {[regexp {^/([^/]+/[^/]+/[^/]+/[^/+!:]+)([+!:]?[^/]*)/?(.*)} $pathInfo m ibi commandString filePath]} {
# possibly a repository
# 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
	} else {
		error {syntax error 4}
	}
	
#	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) {}

	ConditionalSet returnType cgi(ibiurl.returntype) {content}	;# added by GJFB in 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	;# added by GJFB in 2017-02-20 - used by the www.urlib.net resolver to get the url property list from the agency resolvers
	}

#		ibiurl.trueibiflag
#		ibiurl.countoneclickflag
		
# puts [array names cgi]
	set queryList {}	;# added by GJFB in 2013-12-29
	foreach fieldName [array names cgi] {
		if {[lsearch $reservedQueryFieldNames $fieldName] != -1} {continue}
#		regsub -all { } $cgi($fieldName) {+} fieldValue
		set fieldValue $cgi($fieldName)
		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 in 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 in 2017-02-20
}

# ParseIBIURL - end
# ----------------------------------------------------------------------
# ResolveIBI
# used in FindSite2, Get- and Get only

# 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:

if 0 {
# access to data or metadata
# data
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55
	http://gjfb/rep-/iconet.com.br/banon/2001/02.10.22.55
	http://gjfb/LK47B6W/E6H5HH
	http://gjfb/urlib.net/www/2012/10.14.01.35
	http://gjfb/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/iconet.com.br/banon/2001/02.10.22.55.05
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55.05?ibiurl.backgroundlanguage=en
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55.05?ibiurl.backgroundlanguage=fr
# => portuguese (browser setting)
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55.05?choice=short
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55.05?choice=fullBibINPE
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55.05:(BibINPE)
	http://gjfb/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/rep/iconet.com.br/banon/2001/02.10.22.55
	http://gjfb/rep/LK47B6W/E6H5HH
	http://gjfb/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/iconet.com.br/banon/2001/02.10.22.55+
	http://gjfb/LK47B6W/E6H5HH+
	http://gjfb/dpi.inpe.br/banon/2000/02.20.10.44+
	http://gjfb/dpi.inpe.br/banon/2000/02.20.10.08+
# metadata
	http://gjfb/dpi.inpe.br/banon/2000/05.25.20.06+
	http://gjfb/dpi.inpe.br/banon/1999/04.02.15.49+
	http://gjfb/dpi.inpe.br/banon/1999/04.02.15.49+?choice=fullBibINPE
# =>  referencência não disponível no formato BibINPE
	http://gjfb/dpi.inpe.br/banon/1999/04.02.15.49+:(BibINPE)
# =>  referencência não disponível no formato BibINPE
	http://gjfb/dpi.inpe.br/banon/1999/04.02.15.49+:
	
# access to data or metadata content in a specific language
# data
	http://gjfb/iconet.com.br/banon/2001/05.25.16.44+(en)
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55+(fr)
# => language warning
	http://gjfb/LK47B6W/E6H5HH+(pt-BR)
	http://gjfb/dpi.inpe.br/banon/2000/02.20.10.44+(en)
	http://gjfb/dpi.inpe.br/banon/2000/02.20.10.44+(pt-BR)
	http://gjfb/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/8JMKD3MGP7W/3D64LGS
# => portuguese
	http://urlib.net/8JMKD3MGP7W/3D64LGS+(en)
	http://urlib.net/8JMKD3MGP7W/3D6463P
# => english
	http://urlib.net/8JMKD3MGP7W/3D6463P+
	http://urlib.net/8JMKD3MGP7W/3D6463P+(pt-BR)
	http://urlib.net/8JMKD3MGP7W/3D6463P+(en)
	http://urlib.net/8JMKD3MGP7W/3D6463P+(fr)
# => language warning
	http://urlib.net/8JMKD3MGP7W/3D6463P?verblist=GetTranslation(en)
	
# metadata
	http://gjfb/dpi.inpe.br/banon/2000/05.25.20.06
# => portuguese
	http://gjfb/dpi.inpe.br/banon/2000/05.25.20.06+(en)
	http://gjfb/dpi.inpe.br/banon/2000/05.25.20.06+(fr)
# => language warning
	
# access to a specific file
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56/post
	http://gjfb/dpi.inpe.br/banon/1999/06.19.17.00/mirror.cgi?ibiurl.backgroundlanguage=en
	http://gjfb/dpi.inpe.br/banon/1999/06.19.17.00/mirror.cgi/NewPassword
	http://gjfb/83LX3pFwXQZeBBx/hvk3g/mirror.cgi/NewPassword?ibiurl.backgroundlanguage=en
	http://gjfb/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/CBnmVX32PXQZeBBx/RTewE
# => portuguese (browser setting)
	http://gjfb/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/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/iconet.com.br/banon/2001/02.10.22.55+/Readme.html
	
# access to a specific file in a specific language
	http://gjfb/iconet.com.br/banon/2001/05.25.16.44+(en)/Readme.html
	
# access to the list of files
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetFileList
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetFileList&ibiurl.backgroundlanguage=en

# access to metadata
	http://gjfb/iconet.com.br/banon/2001/05.25.16.44?ibiurl.verblist=GetMetadata
	http://gjfb/iconet.com.br/banon/2001/05.25.16.44??
	http://gjfb/iconet.com.br/banon/2001/05.25.16.44:
	http://gjfb/iconet.com.br/banon/2001/05.25.16.44:(BibINPE)
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetTranslation+GetMetadata
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55+:
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55+:(BibINPE)
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56:
	http://gjfb/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/J8LNKB5R7W/3AEMFL5:
	http://gjfb/J8LNKB5R7W/3AEMFL5:?imageflag=0
	
# access to metadata in the preferred language
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56?ibiurl.verblist=GetMetadata+GetTranslation
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56?:+
# => returns the metadata based on languagepreference

# access to metadata in a specific language
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56:+(en)
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56:+(pt-BR)
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56:+(pt)
# => Metadados não encontrados
	http://gjfb/dpi.inpe.br/banon/1998/08.02.08.56:+(fr)
# => Metadados não encontrados

# access to the last edition	
	http://gjfb/rep/J8LNKAN8PW/U3RNES
	http://gjfb/rep/J8LNKAN8PW/U3RNES?ibiurl.verblist=GetLastEdition
	http://gjfb/J8LNKAN8PW/U3RNES!
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55!
# => the last edition is the current one
	http://gjfb/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/iconet.com.br/banon/2001/02.10.22.55!+
	http://gjfb/J8LNKAN8PW/U3RNES!+	
		
# access in a specific language the last edition (in these examples, the result is the same)	
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetTranslation+GetLastEdition
	http://gjfb/iconet.com.br/banon/2001/02.10.22.55+!
	http://gjfb/J8LNKAN8PW/U3RNES+!	

# access a required site
	http://gjfb.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&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=gjfb:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00
	http://gjfb.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+800&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=gjfb:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00
	http://gjfb/83LX3pFwXQZ52hzrGTdYCT/KbJr6?query=ref+conference&fieldlist=author+title
	http://gjfb/83LX3pFwXQZ52hzrGTdYCT/KbJr6?query=ref+conference&fieldlist=author+title&ibiurl.requiredsite=mtc-m18.sid.inpe.br
	http://gjfb/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/iconet.com.br/banon/2001/02.10.22.56
	http://gjfb/iconet.com.br/banon/2001/02.10.22.56+
	http://gjfb/iconet.com.br/banon/2001/02.10.22.56??
	http://gjfb/iconet.com.br/banon/2001/02.10.22.56:
	http://gjfb/iconet.com.br/banon/2001/02.10.22.56+:
	http://gjfb/iconet.com.br/banon/2001/02.10.22.56.05
	
	http://gjfb/rep/iconet.com.br/banon/2001/02.10.22.56
	http://urlib.net/rep/8JMKD3MGP8W/35MMLL9
	
# removed (deleted) ibi
	http://gjfb/J8LNKB5R7W/3E4NFH5
	http://gjfb/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) or server address (gjfb 800}

# ibiurl.returntype								optional	{content}					urlpropertylist				content urlpropertylist																																				if return type is address then the resolver returns the url of the required content, otherwise it returns the content itself - added by GJFB in 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 in 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

# 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.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 AcknowlegeArchive 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]
# cgi/get.tcl:
# set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} $useURLibServerFlag]
# set urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage $currentProcedureName]
# set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} $useURLibServerFlag]
# FindSite2: set urlPropertyList2 [ResolveIBI $parsedIBIURL $contextLanguage $displayWarningMessage {} $useURLibServerFlag]
# ResolveIBI2: return [ResolveIBI [array get ibiURLArray]]


proc ResolveIBI {
	parsedIBIURL {contextLanguage {}} {displayWarningMessage 0} {callingProcedureName {}}
	{useURLibServerFlag 0} {useLocalServerOnlyFlag 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
	
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 ../../../../..

# 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) {}
	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}
	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 in 2015-07-30
		set languagePreference $contextLanguage	;# added by GJFB in 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 49)}
	}
# puts $languagePreference	;# pt-br,en;q=0.5 
# puts $contextLanguage	;# en 
	set criterionArray(clientinformation.languagepreference) $languagePreference	;# just for display
	set criterionArray(clientinformation.contextlanguage) $contextLanguage	;# added by GJFB in 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 in 2017-02-20
	set urlPropertyList [ReturnURLPropertyList2 $criterionList $useURLibServerFlag $useLocalServerOnlyFlag]	;# added by GJFB in 2017-02-20
# 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 in 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) {}
# 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+++
# puts [info exists urlPropertyArray(ibi$type)]
# puts urlPropertyArray(ibi$type)

#	set atLeastOneTranslationWithoutExplicitLanguageflag [regexp {translation\.|translation$]} $type]
	set atLeastOneTranslationWithoutExplicitLanguageflag [regexp {translation(\.|$)]} $type]
# puts $atLeastOneTranslationWithoutExplicitLanguageflag
 	
if {[info exists printFlag] && $printFlag} {
	puts "ResolveIBI2: url$type $depthLevel<BR>"
	puts <BR><BR>
}

	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} {
# the url exists and the required languages of all translations are specified
# puts [SetOutputList $urlPropertyList $requiredItemStatus $type]
		return [SetOutputList $urlPropertyList $requiredItemStatus $type] 
	} else {
# puts --$languagePreference--
		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 {
			regsub {^GetTranslation$} $verb "GetTranslation($preferredLanguage)" verb2	;# Translation -> Translation(pt-BR)
			lappend verbList2 $verb2	
		}
# type
# puts --$verbList2--
# => GetTranslation(pt-BR) (example)
		set type2 [ConvertVerbListToType $verbList2]
# puts $type2	
		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]
		}
	}
# puts $verbList
	set firstVerb [lindex $verbList 0]
#	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
		}
	}
#	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
		}
	}
#	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 in 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)]} {
# 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 $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)]} {
# 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]]	
		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
		}
		
		
	}
	if [string equal {GetFileList} $firstVerb] {
# http://gjfb/iconet.com.br/banon/2001/02.10.22.55?ibiurl.verblist=GetFileList
		return [SetOutputList $urlPropertyList $requiredItemStatus] 
	}
}

# ResolveIBI2 - end
# ----------------------------------------------------------------------
# SetOutputList
# used in ResolveIBI2 only

proc SetOutputList {urlPropertyList requiredItemStatus {type {}}} {
	array set urlPropertyArray $urlPropertyList
	set outputArray(archiveaddress) $urlPropertyArray(archiveaddress)

# puts $type
	
# 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)
	
# 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 in 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 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"
	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/iconet.com.br/banon/2001/02.10.22.56
# http://gjfb/iconet.com.br/banon/2001/02.10.22.55+(fr)
# http://gjfb/dpi.inpe.br/banon/2000/05.25.20.06+(fr)
		catch {subst [set [list ${languageRep2}::identifier warning]]} output
	}
# puts [set [list ${languageRep2}::identifier warning]]
# puts [set [list ${languageRep2}::metadata warning]]
	error $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 in 2012-06-07 - solves the virtual host use (ex: sibgrapi.sid.inpe.br 802)
## used by AcknowlegeArchive and Cover
# used by FindURLPropertyList, Cover, CreateFullBibINPEEntry and Puts (in cgi/copyright.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 in 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 in 2018-05-21
			}
			regexp {[^:]*} $site serverName

if 0 {
# commented by GJFB in 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 in 2019-02-22 because authorization is required in site like gprb0705.sid.inpe.br with Apache 2.4.16
proc GetServerAddressFromHTTPHost {site} {
#	global homePath
	
	if {[llength $site] == 2} {return $site}	;# already a server address (like {gjfb 800})
	regexp {[^:]*} $site serverName
#	Load $homePath/@urlibPort urlibPort	;# commented by GJFB in 2019-08-26
	package require http
	if [catch {http::geturl http://$site/@urlibPort} token] {
		set log "$token\nwhile accessing site: --$site--"
		error [StoreLog {alert} {GetServerAddressFromHTTPHost} $log]	;# added by GJFB in 2018-05-21 - $site might be different from the site calling GetServerAddressFromHTTPHost2, 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]] {
		error "http://$site/@urlibPort not found - do unpost/post of the local collection $site and try again"	;# added by GJFB in 2019-10-04
	}
	set urlibPort [join [http::data $token]]	;# added by GJFB in 2019-08-26
	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 in 2013-01-09 - otherwise ReturnHTTPHost returns the local site http address
	}
	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 in 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]
	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 in 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 in 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 in 2014-08-13
	if ![info exists monthArray($lowerCaseMonth)] {set lowerCaseMonth unknown}	;# added by GJFB in 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 in 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 in 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 within 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

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
 
	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 in 2014-07-01 - drop trailing comma - Banon, Gerald Jean Francis,$ -> Banon, Gerald Jean Francis
									regsub -all { } $name {_} name
									set fieldValue _$name	;# added by GJFB in 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 in 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 in 2014-07-01 - drop trailing comma - Banon, Gerald Jean Francis,$ -> Banon, Gerald Jean Francis
									regsub -all { } $name {_} name
									set fieldValue _$name	;# added by GJFB in 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 in 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 in 2014-07-01 - drop trailing comma - Banon, Gerald Jean Francis,$ -> Banon, Gerald Jean Francis
						regsub -all { } $name {_} name
						set fieldValue _$name	;# added by GJFB in 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] {
				set fieldValue [Execute $site [list GetFieldValue ${rep-i} $fieldName]]
				if ![string equal {} $fieldValue] {
					set fieldValue [string trim $fieldValue]	;# added by GJFB in 2014-07-07 to prevent adding extra than heading and trailing _ 
					regsub -all { } $fieldValue {_} fieldValue
					if $siteInfoFlag {
#						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 in 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
#	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 in 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
# ----------------------------------------------------------------------
# AcknowlegeArchive
# used in col/urlib.net/www/2014/03.16.03.40/doc/cgi/script.tcl only

proc AcknowlegeArchive {urlPropertyList} {
#	global env
	global serverAddress	;# added by GJFB in 2015-02-18 - now AcknowlegeArchive is called from the local site itself
	
	array set urlPropertyArray $urlPropertyList

## state	
#	set state $urlPropertyArray(state)
#	if ![string equal {Deleted} $state] {
# urlKey
		set urlKey $urlPropertyArray(urlkey)
		if ![CheckSession $urlKey urlkey] {
# 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)
				Submit $localURLibClientSocketId [list PostponeOneClickCount $URParts $clientIPAddress]
				close $localURLibClientSocketId
			}
			CloseSession $urlKey urlkey
		}
#	}
}

# AcknowlegeArchive - 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 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
#		bibdigital.sid.inpe.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 {}}

	if [info exists ibiURLArray(parsedibiurl.metadatafieldnamelist)] {
# extraPair2
# 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 in 2017-04-05
		set recipientAddress $agencyHTTPHost/rep-/$ibi$filePath ;# added by GJFB in 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 in 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 in 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 in 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 in 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 in 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

if 1 {
# new version
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 OK
}

	set numberOfResponses 0
	set numberOfSites [llength $messageList]
	set tokenList {}
	if $agencyStructureFlag {	;# added by GJFB in 2019-03-20
		set agencyFailureFlag 0
	}
	
	package require http	;# added by GJFB in 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

# 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 in 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 in 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 in 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 in 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 in 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 in 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] {
#				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 in 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 in 2019-03-20
			if !$agencyFailureFlag {
				foreach token $tokenList {
					if ![info exists ${token}(sock)] {	;# added by GJFB in 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 in 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 in 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 in 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 in 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 in 2019-03-20
		if [string equal {} $listOfibiProperties] {	;# added by GJFB in 2019-03-20
# ibi not found
			set callingProcedureName {}
			set contextLanguage $selectedLanguageFromMirror
			DisplayWarningMessage $ibi $callingProcedureName $contextLanguage $languageRep1 $languageRep2 $localSite	;# runs an error command
		}
	}	

	return $listOfibiProperties
}

} else {
# old version
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 OK
}

	set numberOfResponses 0
	set numberOfSites [llength $messageList]
	set tokenList {}
	if $agencyStructureFlag {	;# added by GJFB in 2019-03-20
		set agencyFailureFlag 0
	}
	
	package require http	;# added by GJFB in 2017-02-22

# FOREACH	
	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
			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 in 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 in 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 in 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 in 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 in 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 in 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] {
#			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 in 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 in 2019-03-20
		if !$agencyFailureFlag {
			foreach token $tokenList {
				if ![info exists ${token}(sock)] {	;# added by GJFB in 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 {[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 in 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 in 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 in 2019-03-20
					if {[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 {[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 {[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 in 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 {[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 in 2019-03-20
		if [string equal {} $listOfibiProperties] {	;# added by GJFB in 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 in 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	;# 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 in 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) and SendPermissionTransferWarningEMail only
# publicKey - added by GJFB in 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 miliseconds - added by GJFB in 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
# ----------------------------------------------------------------------