${cellFont}$translatedCustomizedFieldName
${cellFont}$translatedFootnoteReference
"
lappend rowList $downloadRadioButtons
} else {
# display the check box for the URL field
set chekBoxCode "
${cellFont}$translatedCustomizedFieldName
${cellFont}$translatedFootnoteReference
$chekBoxCode
${cellFont}$translatedCustomizedFieldName
\;$value "
lappend hiddenInputList "
${cellFont}$translatedCustomizedFieldName
${cellFont}$translatedFootnoteReference
"
}
}
lappend rowList " "
}
} elseif {$fieldTypeNumber == 2.2} {
# 2.2
# display check box for the Content Type field
if {$update && [regexp {%@contenttype} $fieldName] && ![regexp {^$|^External Contribution$} $repositoryContentType]} {
# don't display the repository content type check box if the repository content type value is not empty neither External Contribution
# this is done to preserve the current repository content type value if it is not empty neither External Contribution
# just the External Contribution value may be set on-line, the other values must be set using the URLibService interface
lappend rowList "
append row "${cellFont}$translatedCustomizedFieldName
${cellFont}$translatedFootnoteReference "
CreateCheckBox $fieldName $field $value row
append row " "
lappend rowList $row
} elseif {$fieldTypeNumber == 2.3} {
# 2.3
# radio input
lappend rowList "
${cellFont}$translatedCustomizedFieldName
${cellFont}$translatedFootnoteReference
"
set radioOption {}
foreach item $optionTable2($referenceType,$fieldName) {
foreach {customizedOption option} $item {break}
if [info exists translationTable($customizedOption,$referenceType,$fieldName)] {
set translatedCustomizedOption $translationTable($customizedOption,$referenceType,$fieldName)
} else {
# don't translate
set translatedCustomizedOption $customizedOption
}
if [string equal $option $value] {
set checked { CHECKED}
} else {
set checked {}
}
lappend radioOption "$translatedCustomizedOption "
}
lappend rowList "[join $radioOption "
} elseif {$fieldTypeNumber == 3} {
# 3
if 1 {
# added by GJFB on 2021-06-28 to set on-line the Bibliography Data Base option in addition to External Contribution for Misc records which have no contenttype or have as contenttype External Contribution or Bibliography Data Base (ref misc and {not contentty * or contentty external or contentty base})
# display menu for the Content Type field
if {0 && $update && [regexp {%@contenttype} $fieldName] && (![string equal {Misc} $referenceType] || ![regexp {^$|^(External Contribution|Bibliography Data Base)$} $repositoryContentType])} { ;# 0 added by GJFB on 2025-01-24 to let displaying the Content Type field menu (the display control should continue to be defined by the content of displayControl.tcl only)
# don't display the repository content type menu if the reference type is not Misc or the repository content type value is not empty neither External Contribution nor Bibliography Data Base
# this is done to preserve the current repository content type value if it is not empty neither External Contribution
# just the External Contribution and Bibliography Data Base values may be set on-line for Misc, the other values must be set using the URLibService interface
lappend rowList "
append row "${cellFont}$translatedCustomizedFieldName
${cellFont}$translatedFootnoteReference "
append row ""
CreateSelect $fieldName $field $value row ;# updates fillOutFieldCode
if 1 {
if [info exists optionTable2($referenceType,$fieldName)] {
if [regexp {=>} $optionTable2($referenceType,$fieldName)] {
if {[regexp {^%@documentstage$} $fieldName] && \
[string equal {another advanced user} $value]} {
set onLoad {}
}
lappend lineList "if (document.$submissionType.anotheradvanceduser.value == \"\" && document.$submissionType.__documentstage_documentstage.value == \"another advanced user\") {fieldNameList += document.$submissionType.anotheradvanceduserfieldname.value + \"\\\\\\\\\\\\\\\\n\"; i++}"
lappend fillOutFieldCode "
if (document.$submissionType.__documentstage_documentstage.value == \"another advanced user\") {
document.getElementById('anotherAdvancedUser').disabled=false
} else {
document.getElementById('anotherAdvancedUser').disabled=true
document.$submissionType.anotheradvanceduser.value = \"\"
}\
"
ConditionalSet anotherAdvancedUser cgi(anotheradvanceduser) {}
append row " e-Mail (login) "
append row "\n"
append row " "
lappend rowList $row
}
} elseif {[regexp {4|5} $fieldTypeNumber]} {
# 4 or 5
if {[regexp {2.1} [lindex $displayTable($referenceType,%A) 0]] && [regexp {%@resumeid} $fieldName]} {
# multiple creator fields (resumeid field)
# nothing to append
} else {
set preservedValue $value ;# used in hidden type input only
if [string equal {%@parentrepositories} $fieldName] {
# used for review
if {$fieldTypeNumber == 4} {
# display the parent document link
set value "$value "
}
if {$fieldTypeNumber == 5} {
# display the parent document link and the parent reference link
set metadataParentRep [Execute $serverAddressWithIP [list FindMetadataRep $value]]
set value "$Document | $Reference "
}
}
if {$update && [string equal {%@archivingpolicy} $fieldName]} {
# Update archiving policy
set archivingPolicy [Execute $serverAddressWithIP [list UpdateArchivingPolicy $rep $metadataRep administrator $codedPassword] 0] ;# archivingPolicy value is used in this FOREACH to decide hiding or not the read permission field
set value $archivingPolicy
if [regexp {^<(.*)>$} $value m errorMessage] {
puts [join $errorMessage \n]
return
}
# Update archiving policy - end
# Update returnInfo
SetFieldValue $serverAddressWithIP $metadataRep-0 {metadatalastupdate}
# lastupdate=2012:11.08.15.47.18+dpi.inpe.br/banon/1999/01.09.22.14+administrator+{D+2011}
regsub {lastupdate=[^+]*} $returnInfo lastupdate=[lindex $metadatalastupdate 0] returnInfo
# Update returnInfo - end
set preservedValue $value ;# used in hidden type input only
set {archivingPolicyArray(allowpublisher allowfinaldraft)} { => publisher}
set {archivingPolicyArray(denypublisher allowfinaldraft)} { => finaldraft or otherwise publisher}
set {archivingPolicyArray(denypublisher* allowfinaldraft)} { => finaldraft or otherwise publisher}
set {archivingPolicyArray(allowpublisher denyfinaldraft)} { => publisher}
set {archivingPolicyArray(allowpublisher denyfinaldraft*)} { => publisher}
set {archivingPolicyArray(denypublisher denyfinaldraft)} { => publisher or otherwise finaldraft}
set {archivingPolicyArray(denypublisher* denyfinaldraft)} { => publisher}
set {archivingPolicyArray(denypublisher denyfinaldraft*)} { => finaldraft or otherwise publisher}
set {archivingPolicyArray(denypublisher* denyfinaldraft*)} { => publisher}
regsub -all {\d+} $preservedValue {*} arrayEntry
if [info exists archivingPolicyArray($arrayEntry)] {
set value $value$archivingPolicyArray($arrayEntry)
}
}
set value [join [split $value \n] {
${cellFont}$translatedCustomizedFieldName
${cellFont}$translatedFootnoteReference
\;$value
"
lappend hiddenInputList "
${cellFont}\$Code
${cellFont}
"
}
}
# Add Code field - end
set fillOutFieldCode [join $fillOutFieldCode \n] ;# updated in CreateSelect
# puts $requiredFieldList ;# => _A_author _T_title _B_journal _D_year _V_volume
foreach requiredField $requiredFieldList {
regsub {^_} $requiredField {%} field2
regsub {%_} $field2 {%@} field2
regsub -all {e_mail} $field2 {e-mail} field2
regsub {_} $field2 { } field2
set fieldName [lindex $field2 0] ;# %A
set label [lindex $field2 1] ;# author
regsub {e-mail} $label {e_mail} label2
# another advanced user
if [string equal {%@documentstage} $fieldName] {
# lappend lineList "if (document.$submissionType.__documentstage_documentstage.value == \"another advanced user\" && document.$submissionType.anotheradvanceduser.value == \"\") {fieldNameList += document.$submissionType.documentstage.value + \"\\\\\\\\\\\\\\\\n\"; i++}" ;# commented by GJFB on 2016-06-06
lappend lineList "if (document.$submissionType.__documentstage_documentstage.value == \"another advanced user\" && document.$submissionType.anotheradvanceduser.value == \"\") {fieldNameList += document.$submissionType.anotheradvanceduser.value + \"\\\\\\\\\\\\\\\\n\"; i++}" ;# added by GJFB on 2016-06-06
}
# another advanced user - end
# fieldTypeNumber
# set fieldTypeNumber [subst [lindex $displayTable($referenceType,$fieldName) 0]] ;# commented by GJFB on 2016-06-05
set displayValue [subst $displayTable($referenceType,$fieldName)] ;# added by GJFB on 2016-06-05 - subst added to solve a conditonal display of the mark field in Conference Proceeding form based on a list of supervisors (see SetFieldProperties) - subst is needed when using metaforms, e.g., when displayTable contains expression like: {[expr [lsearch -index 1 $supervisorList $userName] == -1?{[list 0 {} {} {}]}:{[list 3 {} {} {Recomendação do orientador}]}]}
set fieldTypeNumber [lindex $displayValue 0] ;# added by GJFB on 2016-06-05
if {$fieldTypeNumber == 2.2} {
# checkbox
set i 0
set conditionList {}
foreach xxx $boxTable($referenceType,$fieldName) {
lappend conditionList "!(document.$submissionType.$requiredField\\\\\\\\\\\\\\\[$i\\\\\\\\\\\\\\\].checked)"
incr i
}
AppendLineList [join $conditionList { && }] $label2
} elseif {$fieldTypeNumber == 2.3} {
# radio
set i 0
set conditionList {}
foreach xxx $optionTable2($referenceType,$fieldName) {
lappend conditionList "!(document.$submissionType.$requiredField\\\\\\\\\\\\\\\[$i\\\\\\\\\\\\\\\].checked)"
incr i
}
AppendLineList [join $conditionList { && }] $label2
} else {
regsub {abstract} $label2 {abstract2} label2 ;# abstract is a reserved word for Netscape
if {[regexp {%A|%@resumeid|%@orcid|%@group|%@affiliation|%@electronicmailaddress} $fieldName] && \
[regexp {2.1} [lindex $displayTable($referenceType,%A) 0]] && \
([regexp {%A} $fieldName] || \
([regexp {%@resumeid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@orcid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@group} $fieldName] && [regexp {^(2.1|3)$} $fieldTypeNumber]) || \
([regexp {%@affiliation} $fieldName] && [regexp {2.1} $fieldTypeNumber]) || \
([regexp {%@electronicmailaddress} $fieldName] && [regexp {2.1} $fieldTypeNumber]))} {
# multiple creator fields
for {set i 1} {$i <= $numberOfCreatorFields} {incr i} {
AppendLineList "document.$submissionType.$requiredField$i.value == \"\"" $label2 $i
}
} else {
if {$fieldTypeNumber != 0} {
# puts $requiredField(*) (meaning required field) even with hidden input
if [string equal {__documentstage_documentstage} $requiredField] {
AppendLineList "document.$submissionType.$requiredField.value == \"not transferred\"" $label2 ;# added by GJFB on 2016-06-06
} else {
if {$update && ![string equal {External Contribution} $repositoryContentType] && [regexp {%@versiontype|%@archivingpolicy} $fieldName]} { ;# added by GJFB on 2017-05-06 - hidden fields cannot be fill out and no required filling warning must be displayed
# update or not External Contribution or (version type or archiving policy field)
# hide the version and archiving policy type field
# do nothing
} else {
AppendLineList "document.$submissionType.$requiredField.value == \"\"" $label2
}
}
}
}
}
}
# seconds
lappend rowList "
${cellFont}\${Folder Name}
${cellFont}[lindex $displayTable($referenceType,foldername) 1]
"
}
# NAME=userfile
# set alternativeFieldNameForFileName [lindex $displayTable($referenceType,filename) 3]
set alternativeFieldNameForFileName [lindex $displayTable($referenceType,filename) 3]
# puts $alternativeFieldNameForFileName
# => File Name
${cellFont}$alternativeFieldNameForFileName
${cellFont}[lindex $displayTable($referenceType,filename) 1]
<$repName > "
} else {
set fillInstruction [subst [lindex $displayTable($referenceType,filename) 1]] ;# subst is to resolve: [expr $update?{}:{(*) }] (see administrator page script)
if {[regexp "$requiredFieldSymbol" $fillInstruction] || \
([info exists requiredFieldAtCloseSymbol] && \
[regexp "$requiredFieldAtCloseSymbol" $fillInstruction])} {
# required field
lappend rowList "
${cellFont}$alternativeFieldNameForFileName
${cellFont}[lindex $displayTable($referenceType,filename) 1]
$chekBoxCode
"
} else {
# testing safari
# with NAME=\"userfile\" safari doesn't work (the next hidden inputs are not sent to the server)
lappend rowList "
${cellFont}$alternativeFieldNameForFileName
${cellFont}[lindex $displayTable($referenceType,filename) 1]
"
}
}
if {[info exists optionTable2($referenceType,%@documentstage)] && [regexp {Closed Review} $optionTable2($referenceType,%@documentstage)] && \
[info exists keywords] && [regexp {review} $keywords]} {
set Object $Review
set object ${a review}
} else {
set Object $Document
set object ${a document}
}
} else {
if {[info exists optionTable2($referenceType,%@documentstage)] && [regexp {Closed Review} $optionTable2($referenceType,%@documentstage)] && \
[info exists keywords] && [regexp {review} $keywords]} {
set Object $Review
set object ${a review}
} else {
if [info exists depositOptionTable($referenceType)] {
array set depositOptionArray $depositOptionTable($referenceType)
}
ConditionalSet copyAbstractToDoc depositOptionArray(copyabstracttodoc) 0
if $copyAbstractToDoc {
set Object $Abstract
set object ${an abstract}
} else {
set Object $Reference
set object ${a reference}
}
}
}
# <
}
# Add File Name field - end
# Migration 25/1/04
if {[info exists maximumSize] && [info exists fileSizeWarningArray($referenceType)]} {
set fileSizeWarning $fileSizeWarningArray($referenceType)
} else {
set fileSizeWarning {}
}
# Migration 25/1/04 - end
if $update {
# update
if {[string equal {all} $updateOption] && \
(![info exists userListWithPermissionToFinish($referenceType)] || \
[lsearch $userListWithPermissionToFinish($referenceType) $advancedUser] != -1)} {
set finishOptionIndex [expr [llength $updateOptionList] - 1]
set ifLine "if (document.update.updatetype\\\\\\\\\\\\\\\[$finishOptionIndex\\\\\\\\\\\\\\\].selected) {" ;# } testing the finish option
set ifLine2 "if (false) {" ;# } don't ask
} elseif {[info exists optionTable2($referenceType,%@documentstage)] && [regexp {Closed Review} $optionTable2($referenceType,%@documentstage)] && \
[regexp {review} $keywords]} {
# is a review
# set ifLine "if ((document.update.__documentstage_documentstage.value != document.update.username.value) && !(document.update.__documentstage_documentstage.value == \"another advanced user\" && document.update.anotheradvanceduser.value == document.update.username.value)) {" ;# } testing reviewer form
# set ifLine2 "if ((document.update.__documentstage_documentstage.value == document.update.username.value) || (document.update.__documentstage_documentstage.value == \"another advanced user\" && document.update.anotheradvanceduser.value == document.update.username.value)) {" ;# } testing reviewer form
set ifLine "if ((document.update.__documentstage_documentstage.value != \"not transferred\") && !(document.update.__documentstage_documentstage.value == \"another advanced user\" && document.update.anotheradvanceduser.value == document.update.username.value)) {" ;# } testing reviewer form
set ifLine2 "if ((document.update.__documentstage_documentstage.value == \"not transferred\") || (document.update.__documentstage_documentstage.value == \"another advanced user\" && document.update.anotheradvanceduser.value == document.update.username.value)) {" ;# } testing reviewer form
} else {
set ifLine "if (false) {" ;# } don't ask
set ifLine2 "if (false) {" ;# } don't ask
}
# action
set action ${Please wait for the update completion.}
} else {
# submit
# action
set action ${Please wait for the submission completion.}
}
# sessionTime
# symmetricKey
# regexp {(.*)-(.*)} [OpenSession $env(REMOTE_ADDR) symmetricKey] m sessionTime symmetricKey
foreach {sessionTime symmetricKey} [OpenSession [list $env(REMOTE_ADDR) administrator] symmetricKey] {break}
# Add username and password fields
if $update {
# update
# insert username and password
# NAME=username
lappend rowList "
${cellFont}$conversionTable(username)
\;
\;$userName
"
} else {
# don't insert username
}
lappend rowList "
[expr [string equal {empty} $env(DOMAIN_NAME)] || ![regexp {^([^<\s@]+)@([^@\s>]+)$} $userName]?{${cellFont}${Password} }:{${cellFont}${Password} ${Forgot it?} }]
${cellFont}$column2Value
"
# an additional hidden input is needed because some browsers are not able to update the password field value with the coded password
# (see ProcessKey JavaScript procedure)
lappend additionalRowList "
${cellFont}${Password}
${cellFont}$helpExpression
"
lappend additionalRowList "
${cellFont}$conversionTable(username)
${cellFont}[lindex $displayTable($referenceType,username) 1]
"
lappend rowList "
[expr [string equal {empty} $env(DOMAIN_NAME)] || !$restrictedSubmission?{${cellFont}${Password} }:{${cellFont}${Password} $passwordHelp }]
${cellFont}[lindex $displayTable($referenceType,password1) 1]
"
# an additional hidden input is needed because some browsers are not able to update the password field value with the coded password
# (see ProcessKey JavaScript procedure)
lappend rowList "
${cellFont}${Password}
${cellFont}[lindex $displayTable($referenceType,password2) 1]
"
lappend rowList "<\$localSite> "
set siteWarning "\${to the site <\$localSite> }"
} else {
Load ../$col/$currentRep/doc/@siteList.txt fileContent
set fileContent [string trim $fileContent " \n"]
regsub -all "\n+" $fileContent "\n" fileContent
set siteList [split $fileContent \n]
set numberOfSites2 [llength $siteList]
if {$numberOfSites2 == 0} {
set siteWarning ""
} else {
global "${languageRep2}::to the site <\$localSite> "
set siteWarning "\${to the site <\$localSite> }"
}
}
# Site warning - end
# Additional instructions
# set in xxFillingInstructions.tcl
ConditionalSet additionalInstructions additionalInstructionsArray($referenceType) {}
# Additional instructions - end
# ifListCreation
set ifListCreation [join $lineList \n]
# ifOrcidListCreation
set ifOrcidListCreation [join $orcidLineList \n]
# ifElectronicMailAddressListCreation
set ifElectronicMailAddressListCreation [join $electronicMailAddressLineList \n]
# displayControl.tcl after 31/1/04 doesn't use the variable below
set requiredPassword $requiredFieldFootnoteTable($referenceType)
# displayControl.tcl after 31/1/04 doesn't use the variable below - end
if ![info exists copyrightArray($referenceType)] {set copyrightArray($referenceType) {}}
ConditionalSet submissionPeriod submissionPeriodArray($referenceType) {}
if ![info exists submitHeaderArray($referenceType)] {set submitHeaderArray($referenceType) {}}
if ![info exists submitFooterArray($referenceType)] {set submitFooterArray($referenceType) {}}
# if [info exists documentStage] {
# lappend hiddenInputList "<\$lastVersion> ."
global "${languageRep2}:: Download it."
global "${languageRep2}::welcome1"
global "${languageRep2}::welcome2"
global "${languageRep2}::You can also access all the full texts of the Archive's own collection through the URLib Local Collection Index ."
global "${languageRep2}::incomplete metadata" ;# introduced in GetSiteInformation
global "${languageRep2}::missing directories" ;# introduced in GetSiteInformation
# package require http ;# needed here as well
set urlibServerAddress $env(URLIB_SERVER_ADDR) ;# urlib.net and port
# foreach {urlibServerName urlibPort} [ReturnCommunicationAddress $urlibServerAddress] {break}
# if {"$env(IP_ADDR) $env(URLIB_PORT)" == "$urlibServerName $urlibPort"} #
if {[string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]} {
# Main Site
set welcome $welcome2
} else {
set welcome $welcome1
}
# numberOfReferencesList
# set query {list GetNumberOfItems}
set query {list GetNumberOfReferences}
# MULTIPLE SUBMIT
set numberOfReferencesList {}
if 0 {
# testing update this page without GetNumberOfReferences
set numberOfSatisfiedQueries 0
set listOfSites 0
set listOfActiveSites 0
set numberOfSites 0
} else {
# GETNUMBEROFREFERENCES
MultipleSubmit {} $query numberOfReferencesList 0
}
set numberOfSites2 $numberOfSites ;# numberOfSites is recomputed while executing GetSiteInformation (and the resulting value may be lower), therefore it must be preserved now
# one or more elements in numberOfReferencesList might contain an error message
# through listOfInactiveSites one can identify the sites that have produced
# the error messages
# puts --$numberOfReferencesList--
# => {{banon-pc3 800} {numberofreferences 806 numberofvisiblereferences 697 numberofvisiblereferenceswithfulltext 585}}
# siteList - used by ReturnSiteInformation in xxAbout.html
set numberOfReferencesList2 {}
set siteList {}
# set failingSiteList {gjfb 19050} ;# for testing
set failingSiteList {} ;# added by GJFB on 2024-05-19 to alert in the xxAbout.html frame about the sites that have a corrupted repArray
foreach siteResult $numberOfReferencesList {
if [string equal {0 0} $siteResult] { ;# see GetNumberOfReferences
lappend failingSiteList [lindex $siteResult 0] ;# added by GJFB on 2024-05-19 to alert in the xxAbout.html frame about the sites that have a corrupted repArray
continue
}
lappend numberOfReferencesList2 $siteResult
lappend siteList [lindex $siteResult 0]
}
# puts $siteList
# siteInformationList
set siteInformationList [join $numberOfReferencesList2]
# for each site, siteInformationList contains
# numberofreferences
# numberofvisiblereferences
# numberofvisiblereferenceswithfulltext
# puts --$siteInformationList--
# =>
# {banon-pc3 800} {numberofreferences 806 numberofvisiblereferences 697 numberofvisiblereferenceswithfulltext 585}
if [string equal {} $siteInformationList] { ;# if added by GJFB on 2024-05-19 to alert in the xxAbout.html frame that the current site has a corrupted repArray (case of an empty @siteList.txt)
puts
puts {The current site has probably a corrupted repArray and should be reset.}
puts
return
}
array set siteInformationArray $siteInformationList
set numberOfItemsList {}
foreach site [array names siteInformationArray] {
# $siteInformationArray($site)
# numberofreferences 300 numberofvisiblereferences 270 numberofvisiblereferenceswithfulltext 150
# puts [list $site --$siteInformationArray($site)--]
array set informationArray $siteInformationArray($site)
lappend numberOfItemsList [list $informationArray(numberofvisiblereferences) $informationArray(numberofvisiblereferenceswithfulltext)]
}
set numberOfItemsList [join $numberOfItemsList]
set numberOfActiveSites $numberOfSatisfiedQueries
set listOfInactiveSites {}
foreach item $listOfSites {
if {[lsearch $listOfActiveSites $item] == -1} {
lappend listOfInactiveSites $item
}
}
# nOR and nOFT
set nOR 0
set nOFT 0
foreach {numberOfVisibleReferences numberofvisiblereferenceswithfulltext} $numberOfItemsList {
set nOR [expr $nOR + $numberOfVisibleReferences]
set nOFT [expr $nOFT + $numberofvisiblereferenceswithfulltext]
}
# MULTIPLE SUBMIT
set command [list list GetSiteInformation] ;# GetSiteInformation is in utilitiesMirror.tcl
# GETSITEINFORMATION
# set siteInformationList [MultipleExecute {} $command] ;# commennted by GJFB on 2013-06-04 - uses @siteList.txt of loBiMiRep (!= $siteList)
set siteInformationList [MultipleExecute $siteList $command] ;# added by GJFB on 2013-06-04
set siteInformationList [join $siteInformationList]
# puts $siteInformationList ;# may contain an error message (e.g., when time-out for GetSiteInformation is large)
if [regexp "<(\{.*\})>" $siteInformationList m errorMessage] {
puts
if [catch {[join $errorMessage \n] message}] {
puts $errorMessage
} else {
puts $message
}
puts
return
}
array set siteInformationArray2 $siteInformationList
foreach site [array names siteInformationArray] {
if [info exists siteInformationArray2($site)] {
set siteInformationArray($site) [concat $siteInformationArray($site) $siteInformationArray2($site)]
}
}
set siteInformationList [array get siteInformationArray] ;# used by ReturnSiteInformation in xxAbout.html
# for each site, siteInformationList contains
# numberofreferences
# numberofvisiblereferences
# numberofvisiblereferenceswithfulltext
# serviceversion
# ipport
# integrityalert
# insertionon
# hourminute
# numberofprocessors
# cpumhz
# ram
# ramuse
# cachesize
# diskspaceavailable
# used
# diskspaceuse
# diskspeed
# indexsize
# puts $siteInformationList
# =>
# {gjfb.home 800} {numberofreferences 895 numberofvisiblereferences 791 numberofvisiblereferenceswithfulltext 683 serviceversion 15:03.06.22.57 ipport {192.168.1.31 80} integrityalert {*} insertionon { } hourminute 20:28 numberofprocessors - cpumhz - ram - ramuse - cachesize - diskspaceavailable - used - diskspaceuse - diskspeed - indexsize {3.2 MiB}}
# Compute the total line
if {[info tclversion] > 8.3} {
set totalNumberOfProcessors 0
set totalDiskSpaceAvailable 0
set totalUsed 0 ;# disk used
set totalNumberOfReferences 0
set totalIndexSize 0
set ipPortList {}
foreach site [array names siteInformationArray] {
if [info exists informationArray] {unset informationArray}
array set informationArray $siteInformationArray($site)
ConditionalSet currentIpPort informationArray(ipport) {}
set lsearchResult [lsearch $ipPortList $currentIpPort]
# totalNumberOfProcessors
if {[string equal {-} $totalNumberOfProcessors] || ![info exists informationArray(numberofprocessors)] || [string equal {-} $informationArray(numberofprocessors)]} {
set totalNumberOfProcessors {-}
} else {
if {$lsearchResult == -1} {
# count only once
incr totalNumberOfProcessors $informationArray(numberofprocessors)
}
}
# totalDiskSpaceAvailable
if {[string equal {-} $totalDiskSpaceAvailable] || ![info exists informationArray(diskspaceavailable)] || [string equal {-} $informationArray(diskspaceavailable)]} {
set totalDiskSpaceAvailable {-}
} else {
if {$lsearchResult == -1} {
# count only once
set totalDiskSpaceAvailable [expr $totalDiskSpaceAvailable + [lindex [regsub { } $informationArray(diskspaceavailable) { }] 0]]
}
}
# totalUsed
if {[string equal {-} $totalUsed] || ![info exists informationArray(used)] || [string equal {-} $informationArray(used)]} {
set totalUsed {-}
} else {
if {$lsearchResult == -1} {
# count only once
set totalUsed [expr $totalUsed + [lindex [regsub { } $informationArray(used) { }] 0]]
}
}
# totalNumberOfReferences
incr totalNumberOfReferences $informationArray(numberofreferences)
# totalIndexSize
if {[string equal {-} $totalIndexSize] || ![info exists informationArray(indexsize)] || [string equal {-} $informationArray(indexsize)]} {
set totalIndexSize {-}
} else {
set totalIndexSize [expr $totalIndexSize + [lindex [regsub { } $informationArray(indexsize) { }] 0]]
}
# ipPortList
if [info exists informationArray(ipport)] {
lappend ipPortList $informationArray(ipport)
}
}
# Add units
# puts --$totalUsed--
# puts --$totalDiskSpaceAvailable--
if {[string equal {-} $totalDiskSpaceAvailable] || $totalDiskSpaceAvailable == 0} {
set totalDiskSpaceUse {-}
set totalDiskSpaceAvailable {-}
} else {
set totalDiskSpaceUse [expr int(100 * ($totalUsed / double($totalDiskSpaceAvailable)))]%
set totalDiskSpaceAvailable [format "%.1f [lindex [regsub { } $informationArray(diskspaceavailable) { }] 1]" $totalDiskSpaceAvailable]
}
if ![string equal {-} $totalUsed] {
set totalUsed [format "%.1f [lindex [regsub { } $informationArray(used) { }] 1]" $totalUsed]
}
if ![string equal {-} $totalIndexSize] {
set totalIndexSize [format "%.1f [lindex [regsub { } $informationArray(indexsize) { }] 1]" $totalIndexSize]
}
# Add units - end
}
# Compute the total line - end
# URLibReferenceRep
set URLibReferenceRep iconet.com.br/banon/2001/02.10.22.55
# puts $numberOfSites
if {$numberOfSites2 == 1} {
set siteWarning " "
} else {
set siteWarning "\${ was distributed over \$numberOfActiveSites
within a total of \$numberOfSites2 Archives and it }"
}
if 0 {
# if {"$env(IP_ADDR) $env(URLIB_PORT)" == "$urlibServerName $urlibPort"} #
if {[string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]} {
# Main site
set lastVersionWarning ""
set downloadWarning ""
} else {
# lastVersion
set query {list GetURLibServiceLastVersion}
# MULTIPLE SUBMIT
set lastVersion {}
# MultipleSubmit {} $query lastVersion 0 [list $urlibServerAddress2]
MultipleSubmit {} $query lastVersion 1 [list $urlibServerAddress2]
if [string equal {} $lastVersion] {
set lastVersionWarning ""
} else {
set lastVersionWarning "\${<\$lastVersion> .}"
}
if [string equal $env(SERVICE_VERSION) $lastVersion] {
set downloadWarning ""
} else {
set downloadWarning "\${ Download it.}"
}
}
} else {
set lastVersionWarning ""
set downloadWarning ""
}
# Get number of visits
# set numberOfVisits [Execute $serverAddressWithIP [list GetNumberOfVisits $env(LOBIMIREP)]]
set numberOfVisits [Execute $serverAddressWithIP [list GetNumberOfVisits $currentRep]]
# Get number of visits - end
# Link to index1.html
if [file exists ../$col/$env(LOCOINREP)/doc/index1.html] {
set indexHTML "\${You can also access all the full texts of the Archive's own collection through the URLib Local Collection Index .}"
} else {
set indexHTML ""
}
# Link to index1.html - end
if 1 {
# added by GJFB on 2024-03-10 to inform if the INPE servers have their sentinel process turned on or off
# < ip > < host >
# < server > < server > < server >
# 150.163.34.241 {{marte.sid.inpe.br 800} {marte2.sid.inpe.br 802} {marte3.sid.inpe.br 804}}
# < site > < site > < site >
if {0 || [string equal {bibdigital.sid.inpe.br 800} $serverAddress]} {
Load ../$col/$currentRep/doc/@siteList.txt fileContent
set lineList [split $fileContent \n]
# lappend lineList {{bibdigital.sid.inpe.br 800} sid.inpe.br/bibdigital@80/2006/04.07.15.50 150.163.34.247} ;# commented by GJFB on 2025-06-23
lappend lineList {{bibdigital.sid.inpe.br 800} sid.inpe.br/bibdigital@80/2006/04.07.15.50 150.163.105.17} ;# added by GJFB on 2025-06-23
# ipSiteArray
foreach line $lineList {
foreach {site archive ip} $line {break}
lappend ipSiteArray($ip) $site
}
# puts [array get ipSiteArray]
## => 150.163.34.241 {{marte.sid.inpe.br 800} {marte2.sid.inpe.br 802} {marte3.sid.inpe.br 804}} 150.163.34.249 {{mtc-m12.sid.inpe.br 800}} ...
# ipHostArray
foreach ip [array names ipSiteArray] {
foreach site $ipSiteArray($ip) {
foreach {server port} $site {break}
if [string equal {800} $port] {
set ipHostArray($ip) $server
break
}
}
}
# puts [array get ipHostArray]
# => 150.163.34.241 marte.sid.inpe.br 150.163.34.249 mtc-m12.sid.inpe.br ...
# hostFlagArray
foreach ip [array names ipHostArray] {
set host $ipHostArray($ip)
set site [lindex $ipSiteArray($ip) 0]
# set hostFlagArray($host) [Execute $site [list TestSentinelProcess]] ;# return 1 if the sentinel pid is known exists and 0 otherwise - commented by GJFB on 2024-03-22 because some sites might be slow
# set hostFlagArray($host) [Execute $site [list TestSentinelProcess] 0] ;# return 1 if the sentinel process exists and 0 otherwise - added by GJFB on 2024-03-22
if [catch {Execute $site [list TestSentinelProcess] 0} hostFlagArray($host)] { ;# return 1 if the sentinel process is running, 0 otherwise and "-" if undefined - added by GJFB on 2024-03-22
# communication with server [marte.sid.inpe.br 800] doesn't start
set hostFlagArray($host) - ;# "-' means that the sentinel state is indefined
}
}
# monitoringList
set hostFlagList [array get hostFlagArray] ;# used in pt-BRAbout.html only
foreach {host flag} $hostFlagList {
lappend monitoringList [list $host $flag]
}
}
}
# translationTable
source ../$col/$languageRep2/doc/mirror/${language}ReferenceTypeName.tcl ;# set translationTable
# global referencetype::translationTable
if [file exists ../$col/$languageRep1/doc/${language}About.html] {
Load ../$col/$languageRep1/doc/${language}About.html body
} else {
Load ../$col/$languageRep2/doc/${language}About.html body
}
set body [ProcessBrackets $body]
# puts $body
# puts $currentRep
# catch {subst $body} output
set output [subst $body]
set output [UnProcessBrackets $output]
set output [ProcessBrackets $output]
set output [SetFont [subst [subst $output]]]
set output [UnProcessBrackets $output]
set dirName [file dirname $alternatePath]
file mkdir $dirName ;# create the auxdoc directory in the mirrorHomePage.html repository
Store output $alternatePath
} else {
Load $alternatePath output
}
if [regexp -nocase {< *meta +charset *= *" *UTF-8.*".*>} $output] { ;# added by GJFB on 2026-04-04 to solve the accent problem
puts {Content-Type: text/html; charset=UTF-8}
} else {
puts {Content-Type: text/html}
}
puts {}
} ;# About - end
^BlankPage$ {
# used in xxForm.html to leave the input text (query) fixed when clicking +/-
# the blank page is displayed in the frame called BlackHole
return
}
.+ {
if [file exists ../$col/$languageRep1/doc/${language}$frameName.html] {
Load ../$col/$languageRep1/doc/${language}$frameName.html fileContent
set fileContent2 [ProcessBrackets $fileContent]
if [catch {subst $fileContent2} fileContent] {
return -code error "CreateMirror (2):
$fileContent
"
} else {
set output [UnProcessBrackets $fileContent]
}
} else {
return -code error "CreateMirror (3): file
$homePath/col/$languageRep1/doc/${language}$frameName.html
doesn't exist"
}
}
default {
# empty frameName
# puts OK
if $usePHP {
puts "Location: http://$localSite/col/$mirrorHomePageRep/doc/$mirrorHomePageTargetFile"
puts {}
return
}
# puts $env(QUERY_STRING)
# targetFrame
set targetFrame _top
if [info exists env(QUERY_STRING)] {
regexp {targetframe=([^&]*)} $env(QUERY_STRING) m targetFrame
}
# Capture URL (same code in createpage.tcl)
set q_u_e_r_y {}
if {[info exists env(QUERY_STRING)] && ![string equal {} $env(QUERY_STRING)]} {
# GET style
lappend q_u_e_r_y $env(QUERY_STRING)
}
if [info exists env(CONTENT_LENGTH)] {
# POST style
lappend q_u_e_r_y [string trim [read stdin $env(CONTENT_LENGTH)] \n]
}
# puts $q_u_e_r_y
set q_u_e_r_y [join $q_u_e_r_y &]
foreach {name value} [split $q_u_e_r_y &=] {
set cgi([DecodeURL $name]) [DecodeURL $value]
}
# puts [array get cgi]
# Capture URL - end
# Source displayControl.tcl
set enableOutput 1
eval $sourceDisplayControl ;# set mirrorPageOpeningOption
# Source displayControl.tcl - end
# frameName
# ConditionalSet frameName cgi(framename) {Recent} ;# used in the mirror home page file - value is Recent or About - commented by GJFB on 2020-07-17
if [info exists cgi(framename)] {
set frameName $cgi(framename)
} else {
ConditionalSet frameName mirrorPageOpeningOption {Recent} ;# used in the mirror home page file - value is Recent or About
}
# accent
ConditionalSet accent cgi(accent) {no} ;# used in the mirror home page file - value is yes or no
# case
ConditionalSet case cgi(case) {no} ;# used in the mirror home page file - value is yes or no
# continue
ConditionalSet continue cgi(continue) {no} ;# used in the mirror home page file - value is yes or no
# returnButton
ConditionalSet returnButton cgi(returnbutton) {yes} ;# added by GLFB in 2022-09-11 - used in the mirror home page file - value is yes or no
# choice
ConditionalSet choice cgi(choice) {brief} ;# used in the mirror home page file - value is short, brief, briefTitleAuthor, briefTitleAuthorMisc, full, fullbibtex, fullrefer, fullBibINPE or fullXML
# query
ConditionalSet query cgi(query) {} ;# added by GJFB on 2022-06-13 - used in the mirror home page file - value is a search expression
# query2
ConditionalSet query2 cgi(query2) {} ;# added by GJFB on 2022-06-13 - used (via searchInputValue) in the mirror home page file - value is a search expression
# ConditionalSet query2 cgi(query2) {referencetype Report and rep *2011*} ;# for testing
set query2 {} ;# query2 not in use
regsub -all { } $query2 {+} query2
# searchInputValue
ConditionalSet searchInputValue cgi(searchinputvalue) $query ;# added by GJFB on 2022-06-13 - used in the mirror home page file - value is a search expression
# searchInputValue2
regsub -all { } $searchInputValue {+} searchInputValue2 ;# added by GJFB on 2022-06-13 - used in the mirror home page file - value is a search expression for URL
# forceRecentFlag
ConditionalSet forceRecentFlag cgi(forcerecentflag) 0 ;# added by GJFB on 2022-06-13 - used in the mirror home page file - value is 0 (default) or 1 (means to force 'The Most Recent' display)
# forceHistoryBackFlag
set forceHistoryBackFlag 0 ;# added by GJFB on 2023-06-09
# highlightAbout
ConditionalSet highlightAbout cgi(highlightabout) 0 ;# added by GJFB on 2022-09-11 - used in the mirror home page file - value is 0 (default) or 1 (means to highlight the About button background)
# set serverAddress $localSite ;# old usage of serverAddress - commented by GJFB on 2020-07-17 to preserve the value of serverAddress used in mirrorHomePage.html
# Load ../$col/$mirrorHomePageRep/service/targetFile mirrorHomePageTargetFile
# puts ../$col/$mirrorHomePageRep/doc/$mirrorHomePageTargetFile
# if [file exists ../$col/$mirrorHomePageRep/doc/$mirrorHomePageTargetFile] # ;# commented by GJFB on 2025-01-10 because mirrorHomePageTargetFile value might be empty when, for example, customizing a Bibliographic Mirror to just create a meta form for conference proceedings
if {![string equal {} $mirrorHomePageTargetFile] && [file exists ../$col/$mirrorHomePageRep/doc/$mirrorHomePageTargetFile]} { ;# added by GJFB on 2025-01-10
Load ../$col/$mirrorHomePageRep/doc/$mirrorHomePageTargetFile mirrorPage
if {![regexp {[[:print:]]} $mirrorPage]} {
# mirrorPage doesn't contain printed characters
return -code error "CreateMirror (4): file
$homePath/col/$mirrorHomePageRep/doc/$mirrorHomePageTargetFile
is corrupted"
}
} else {
# Load the Default mirror home page
# Load ../$col/$mirrorHomePageRepository/doc/$mirrorHomePageTargetFile mirrorPage ;# commented by GJFB on 2025-01-10 because mirrorHomePageTargetFile value might be empty whem customizing/creating/using a meta form only
Load ../$col/$mirrorHomePageRepository/doc/mirrorHomePage.html mirrorPage ;# added by GJFB on 2025-01-10
}
if [file exists ../$col/$mirrorHomePageRep/doc/mirrorHomePageHeader.html] {
Load ../$col/$mirrorHomePageRep/doc/mirrorHomePageHeader.html mirrorHomePageHeader
} else {
set mirrorHomePageHeader {}
}
# puts ../$col/$languageRep2/doc/mirror/${language}Home.tcl
source ../$col/$languageRep2/doc/mirror/${language}Home.tcl ;# set the proper translation of the each variable below
global "${languageRep2}::Bibliographic Mirror at <\;\$serverAddress>\;" ;# for old mirror home page
global "${languageRep2}::Bibliographic Mirror at <\;\$localSite>\;"
global "${languageRep2}::Browser assisted filling"
global "${languageRep2}::Keyword-driven filling"
global "${languageRep2}::Toggle the filling property"
global "${languageRep2}::Remove past inserted search expressions"
global "${languageRep2}::Are you sure you want to remove the past inserted search expressions and reload this page?"
global "${languageRep2}::Press Backspace or type something..."
global "${languageRep2}::Please wait for the submission completion."
set thisRepository $mirrorHomePageRep
set urlibServerAddress $env(URLIB_SERVER_ADDR) ;# urlib.net and port (www.urlib.net 800)
# foreach {urlibServerName urlibPort} [ReturnCommunicationAddress $urlibServerAddress] {break} ;# used in mirrorPage
foreach {sessionTime symmetricKey} [OpenSession [list $env(REMOTE_ADDR) administrator] symmetricKey] {break}
Load $homePath/col/$currentRep/doc/@wordOccurrence wordOccurrenceList
set keywordList {}
# puts $wordOccurrenceList
foreach item $wordOccurrenceList {
foreach keyword $item {break}
# set keyword "- [regsub -all {\$} $keyword {\\\\\$}],"
set keyword [regsub -all {\$} $keyword {\\\\\$}]
set keyword [regsub -all {'} $keyword {\\\'}]
# set keyword [regsub -all {:} $keyword {\\\:}]
set keyword "- $keyword,"
lappend keywordList \\\"$keyword\\\"
# lappend keywordList \\\"_[regsub -all { } $keyword {_}]\\\" ;# join must not be used because keyword may contain an open brace
}
# puts $keywordList
set data \\\[[join $keywordList {, }]\\\]
# seconds
set seconds "CreateMirror (5): $m "
if 0 {global errorInfo; puts $errorInfo }
}
}
}
# CreateMirror - end
# ----------------------------------------------------------------------
# CreateSelect
# used with Register and Submit
# example of fieldName: %A
# example of field: _A_author
# creatorNumber is empty or is 1, 2, 3 ...
proc CreateSelect {fieldName field value varName {creatorNumber {}}} {
global cgi
# upvar translationTable translationTable
upvar referenceType referenceType
upvar optionTable optionTable
upvar optionTable2 optionTable2
upvar defaultOptionTable defaultOptionTable
upvar $varName row
upvar userName userName
upvar fillOutFieldCode fillOutFieldCode ;# used in xxSubmit.html and xxUpdateSubmission.html only
upvar fieldList fieldList ;# {%A author} {%T title} ... {%@affiliation affiliation} ...
upvar fillOutFieldTable fillOutFieldTable ;# set in displayControl.tcl
upvar actionTable actionTable ;# set in displayControl.tcl
upvar submissionType submissionType
upvar referenceType3 referenceType3
upvar language language
upvar http http
upvar update update ;# added by GJFB on 2016-05-28 - needed when running iconet.com.br/banon/2006/07.02.02.18/cgi/script (k metaform) (when setting {controlArray(optionTable2(Conference Proceedings,%@documentstage))} in that cgi script)
upvar supervisorList supervisorList ;# added by GJFB on 2016-05-28 - needed when running iconet.com.br/banon/2006/07.02.02.18/cgi/script (k metaform) (when setting {controlArray(optionTable2(Conference Proceedings,%@documentstage))} in that cgi script)
upvar userName userName ;# added by GJFB on 2016-05-28 - needed when running iconet.com.br/banon/2006/07.02.02.18/cgi/script (k metaform) (when setting {controlArray(optionTable2(Conference Proceedings,%@documentstage))} in that cgi script)
upvar userGroup userGroup ;# added by GJFB on 2016-05-28 - needed when running iconet.com.br/banon/2006/07.02.02.18/cgi/script (k metaform) (when setting {controlArray(optionTable2(Conference Proceedings,%@documentstage))} in that cgi script)
# Create fillOutFieldCode
# for function FillOutField(fieldName, optionNumber, creatorNumber)
if [info exists actionTable($referenceType,$fieldName)] {
# Dynamic action
# actionTable is set in displayControl.tcl
lappend fillOutFieldCode " if (fieldName == \"$fieldName\") \{"
set i 0
lappend fillOutFieldCode " itemsAction = new Array([llength $actionTable($referenceType,$fieldName)])"
foreach item $actionTable($referenceType,$fieldName) {
lappend fillOutFieldCode " itemsAction\\\\\\\\\\\\\\\[$i\\\\\\\\\\\\\\\] = \"$http://[lindex [lindex $item 1] 0]/col/[lindex [lindex $item 1] 1]/doc/submit.cgi\""
incr i
}
lappend fillOutFieldCode " document.$submissionType.action = itemsAction\\\\\\\\\\\\\\\[optionNumber\\\\\\\\\\\\\\\] + '?%0+referencetype=\{$referenceType3\}&languagebutton=$language&returnbutton=$cgi(returnbutton)&targetframe=$cgi(targetframe)&attachment=$cgi(attachment)'"
lappend fillOutFieldCode " \}"
# Dynamic action - end
}
set fillOutFieldCode2 {}
foreach name [array names fillOutFieldTable $referenceType,$fieldName,*] {
# Journal Article,%@group,%@affiliation
# fieldName == %@group
regsub "^$referenceType,$fieldName," $name {} destinationFieldName ;# %@affiliation
if {[set i [lsearch -regexp $fieldList ^$destinationFieldName]] != -1} {
set destinationField [lindex $fieldList $i] ;# %@affiliation affiliation
regsub -all {%|@| |-} $destinationField {_} destinationField ;# for JavaScript compatibility - __affiliation_affiliation
if [regexp {^$|^1$} $creatorNumber] {
lappend fillOutFieldCode2 " items$destinationField = new Array([expr [llength $fillOutFieldTable($name)] / 2])"
set i 0
foreach {x y} $fillOutFieldTable($name) {
lappend fillOutFieldCode2 " items$destinationField\\\\\\\\\\\\\\\[$i\\\\\\\\\\\\\\\] = \"$y\""
incr i
}
}
lappend fillOutFieldCode2 " if (creatorNumber == \"$creatorNumber\") \{"
lappend fillOutFieldCode2 " document.$submissionType.$destinationField$creatorNumber.value = items$destinationField\\\\\\\\\\\\\\\[optionNumber\\\\\\\\\\\\\\\]"
lappend fillOutFieldCode2 " \}"
}
}
if ![string equal {} $fillOutFieldCode2] {
lappend fillOutFieldCode "if (fieldName == \"$fieldName\") \{"
set fillOutFieldCode [concat $fillOutFieldCode $fillOutFieldCode2]
lappend fillOutFieldCode " \}"
}
# Create fillOutFieldCode - end
# ONCHANGE="FillOutField('%@group', document.update.__group_group1.selectedIndex, '1')"
append row ""
# Find option list
# optionList
if [info exists optionTable($referenceType,$fieldName)] {
set optionList $optionTable($referenceType,$fieldName)
} elseif [info exists optionTable2($referenceType,$fieldName)] {
# set optionList $optionTable2($referenceType,$fieldName) ;# commented by GJFB on 2016-05-28
set optionList [subst $optionTable2($referenceType,$fieldName)] ;# added by GJFB on 2016-05-28 - subst needed when running iconet.com.br/banon/2006/07.02.02.18/cgi/script (k metaform) (when setting {controlArray(optionTable2(Conference Proceedings,%@documentstage))} in this cgi script)
} else {
puts "optionTable($referenceType,$fieldName) or optionTable2($referenceType,$fieldName) doesn't exist"
return
}
# Find option list - end
# http://vaio:1905/col/iconet.com.br/banon/2006/11.26.21.31/doc/mirror.cgi/Submit/Book?languagebutton=pt-BR&reviewprocess=yes
# puts $fieldName
# puts --$value--
# puts $optionList
if [info exists defaultOptionTable($referenceType,$fieldName)] {
if [string equal {} $value] {
set value $defaultOptionTable($referenceType,$fieldName)
} elseif {[string equal {%@documentstage} $fieldName]} {
# with 8.5 could be [lsearch -index 1 $optionList $value] == -1
set flag 1
foreach option $optionList {
if [string equal [lindex $option 1] $value] {set flag 0; break}
}
if $flag {set value $defaultOptionTable($referenceType,$fieldName)}
}
}
# puts ---$value---
# puts $optionList
if [info exists optionTable($referenceType,$fieldName)] {
# using optionTable
set flag 1
for {set i 0} {$i < [llength $optionList]} {incr i} {
if {[llength [lindex [lindex $optionList $i] 1]] > 1} {set flag 0; break}
}
if $flag {
# without subitem
foreach option $optionList {
CreateOptionForSelect $fieldName $value $option $option ;# appends row
}
} else {
# with subitems (an item has at least two subitems)
if [string equal {} [lindex $optionList 0]] {
# the first element is empty
set optionList [lreplace $optionList 0 0]
CreateOptionForSelect $fieldName $value {} {} ;# appends row
}
foreach option $optionList {
append row ""
foreach option2 [lindex $option 1] {
CreateOptionForSelect $fieldName $value $option2 $option2 ;# appends row
}
append row " "
}
}
} else {
# using optionTable2
# puts --$optionList--
set flag [expr [llength [lindex [lindex [lindex $optionList end] 1] 0]] <= 1]
if $flag {
# without subitem
foreach option $optionList {
set optionName [lindex $option 0]
set optionValue [lindex $option 1]
# puts [list CreateOptionForSelect $fieldName $value $optionName $optionValue]"
foreach option2 [lindex $option 1] {
set optionName [lindex $option2 0]
set optionValue [lindex $option2 1]
CreateOptionForSelect $fieldName $value $optionName $optionValue ;# appends row
}
append row " "
}
}
}
append row
}
# CreateSelect - end
# ----------------------------------------------------------------------
# CreateOptionForSelect
# example of argument values:
# fieldName == %@group
# fieldValue == CST-CST-INPE-MCTI-GOV-BR
# optionName == CST
# optionValue == CST-CST-INPE-MCTI-GOV-BR
# optionValue == CST-CST-SPG-INPE-MCTI-GOV-BR
proc CreateOptionForSelect {fieldName fieldValue optionName optionValue} {
# puts [list $fieldName $fieldValue $optionName $optionValue]
upvar row row
upvar 2 translationTable translationTable
upvar 2 referenceType referenceType
if [info exists translationTable($optionName,$referenceType,$fieldName)] {
set translatedOption $translationTable($optionName,$referenceType,$fieldName)
} else {
# don't translate
set translatedOption $optionName
}
# puts [string equal $fieldValue $optionValue]$translatedOption "
} else {
append row "$translatedOption "
}
}
# CreateOptionForSelect - end
# ----------------------------------------------------------------------
# CreateCheckBox
# used with Register and Submit
# example of fieldName: %A
# example of field: _A_author
proc CreateCheckBox {fieldName field value varName} {
upvar referenceType referenceType
upvar boxTable boxTable
upvar $varName row
upvar userName userName
set boxValues $boxTable($referenceType,$fieldName)
if {[llength [lindex [lindex $boxValues 0] 1]] <= 1} {
# without subitem
foreach box $boxValues {
if [string equal {} [lindex $box 0]] {continue}
CreateBoxForCheckBox $fieldName $value $field $box ;# appends row
}
} else {
# with subitems (the first item has at least two subitems)
foreach box $boxValues {
append row [lindex $box 0]$translatedName $translatedName (*) }] (see administrator page script)
if [regexp "$requiredFieldSymbol" $fillInstruction] {
lappend lineList "if ($condition) {fieldNameList += document.$submissionType.$label2$i.value + \"\\\\\\\\\\\\\\\\n\"; i++}"
} else {
if {[info exists optionTable2($referenceType,%@documentstage)] && [regexp {Closed Review} $optionTable2($referenceType,%@documentstage)]} {
lappend lineList "if (document.$submissionType.__documentstage_documentstage.value == \"Closed Review\" && $condition) {fieldNameList += document.$submissionType.$label2.value + \"\\\\\\\\\\\\\\\\n\"; i++}"
}
}
}
# AppendLineList - end
# ----------------------------------------------------------------------
# CompareFieldName
proc CompareFieldName {a b} {
global orderingFieldArray
set a1 [lindex $a 0] ;# %A
set b1 [lindex $b 0]
if {[info exists orderingFieldArray($a1)] && \
[info exists orderingFieldArray($b1)]} {
set a2 $orderingFieldArray($a1)
set b2 $orderingFieldArray($b1)
return [expr $a2<=$b2?-1:1]
} elseif {[info exists orderingFieldArray($a1)] && \
![info exists orderingFieldArray($b1)]} {
return -1
} elseif {![info exists orderingFieldArray($a1)] && \
[info exists orderingFieldArray($b1)]} {
return 1
} else {
return 0
}
}
# CompareFieldName - end
# ----------------------------------------------------------------------
# FindFieldValue
# example:
# FindFieldValue {__group_group} %@group group $referenceType $update
proc FindFieldValue {field fieldName label referenceType update} {
global cgi
global multipleLineReferFieldNamePattern
global multipleLineReferFieldNamePattern2
global multipleLineReferFieldNamePatternForCreator
upvar displayTable displayTable
upvar localMetadataArray localMetadataArray
upvar reviewArray reviewArray
upvar metadataRep metadataRep
upvar repName repName
upvar sourceFieldNameArray sourceFieldNameArray
upvar languageRep1 languageRep1 ;# added by GJFB on 2016-06-05
upvar languageRep2 languageRep2 ;# added by GJFB on 2016-06-05
upvar firstLanguageRep firstLanguageRep ;# added by GJFB on 2016-06-05
upvar submissionFormRep submissionFormRep ;# added by GJFB on 2016-06-05
upvar submissionFormLanguage submissionFormLanguage ;# added by GJFB on 2016-06-05
upvar submissionFormLanguageRep submissionFormLanguageRep ;# added by GJFB on 2016-06-05
upvar submissionType submissionType ;# added by GJFB on 2016-06-05
upvar supervisorList supervisorList ;# added by GJFB on 2016-06-05
upvar userName userName ;# added by GJFB on 2016-06-05
if [info exists cgi(sourcereferencetype)] {
if [info exists sourceFieldNameArray($fieldName)] {
set label2 $sourceFieldNameArray($fieldName)
} else {
set label2 {}
}
} else {
set label2 $label
}
# fieldTypeNumber
if [info exists displayTable($referenceType,$fieldName)] {
# set fieldTypeNumber [subst [lindex $displayTable($referenceType,$fieldName) 0]] ;# commented by GJFB on 2016-06-05
set displayValue [subst $displayTable($referenceType,$fieldName)] ;# added by GJFB on 2016-06-05 - subst added to solve a conditonal display of the mark field in Conference Proceeding form based on a list of supervisors (see SetFieldProperties) - subst is needed when using metaforms, e.g., when displayTable contains expression like: {[expr [lsearch -index 1 $supervisorList $userName] == -1?{[list 0 {} {} {}]}:{[list 3 {} {} {Recomendação do orientador}]}]}
set fieldTypeNumber [lindex $displayValue 0] ;# added by GJFB on 2016-06-05
}
if [info exists cgi($field)] {
if {[regexp {%A|%@resumeid|%@orcid|%@group|%@affiliation|%@electronicmailaddress} $fieldName] && \
[info exists displayTable($referenceType,$fieldName)] && \
[regexp {2.1} [lindex $displayTable($referenceType,%A) 0]] && \
![string equal {Resume} $referenceType] && \
([regexp {%A} $fieldName] || \
([regexp {%@resumeid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@orcid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@group} $fieldName] && [regexp {^(2.1|3)$} $fieldTypeNumber]) || \
([regexp {%@affiliation} $fieldName] && [regexp {2.1} $fieldTypeNumber]) || \
([regexp {%@electronicmailaddress} $fieldName] && [regexp {2.1} $fieldTypeNumber]))} {
# multiple creator fields
# change into a list
if {[info exists cgi(passworderror)] && $cgi(passworderror)} {
regsub -all {\s\n} $cgi($field) "\n" value ;# drop extra blank lines (needed when returning after a wrong password)
} else {
set value $cgi($field)
}
set value [split $value \n]
if ![llength $value] {set value {{}}} ;# to avoid zero creator field
# puts --$value--
} else {
set value $cgi($field)
# regsub -all {"} $value {\"} value ;# " -> " - " leads to problem in INPUT VALUE
}
# Store value C:/tmp/aaa binary 0 a
# puts $field--$value--
# regsub -all "\n" $value {} value ;# preserve lines ! (otherwise we get double lines) - doesn't work with multiple creator fields
regsub -all {\s\n} $value "\n" value ;# TEXTAREA adds one blank line between each line
} elseif {$update && [info exists localMetadataArray($metadataRep-0,$label2)]} {
# VALUE
set value $localMetadataArray($metadataRep-0,$label2)
# puts $multipleLineReferFieldNamePattern2
# => A|E|Y|\?|O|@isbn|@lineage|@group|@orcid|@readergroup|@archivist|@sponsor|@resumeid|@affiliation|@supervisor|@electronicmailaddress|@issn|@usergroup
if [regexp $multipleLineReferFieldNamePattern2 $fieldName] {
# multiple line fields
# puts $value
# if [regexp {^%@group|^%@affiliation|^%@electronicmailaddress} $fieldName] #
if ![regexp $multipleLineReferFieldNamePatternForCreator $fieldName] {
set value [MultipleRegsub {,*$} $value {}] ;# drop trailing commas
} else {
# puts $value
# set value [MultipleRegsub {(,.+),$|^([^ ]+),$} $value {\1\2}] ;# drop trailing comma
set value [MultipleRegsub {(,[^()]+),$|^([^ ]+),$|(,.+\(.*\)),$} $value {\1\2\3}] ;# drop trailing comma - added by GJFB on 2018-02-28 to solve cases like {aa, bb (dd, ff),} (-> aa, bb (dd, ff)) and {aa bb (dd, ff),} (-> aa, bb (dd, ff),) - useful when filling out the component field
}
if {[regexp {%A|%@resumeid|%@orcid|%@group|%@affiliation|%@electronicmailaddress} $fieldName] && \
[info exists displayTable($referenceType,$fieldName)] && \
[regexp {2.1} [lindex $displayTable($referenceType,%A) 0]] && \
![string equal {Resume} $referenceType] && \
([regexp {%A} $fieldName] || \
([regexp {%@resumeid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@orcid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@group} $fieldName] && [regexp {^(2.1|3)$} $fieldTypeNumber]) || \
([regexp {%@affiliation} $fieldName] && [regexp {2.1} $fieldTypeNumber]) || \
([regexp {%@electronicmailaddress} $fieldName] && [regexp {2.1} $fieldTypeNumber]))} {
# multiple creator fields
# leave as a list
} else {
# puts $fieldName
# puts 1--$value--
if [regexp {%A|%@resumeid|%@orcid|%@group|%@affiliation|%@electronicmailaddress} $fieldName] { ;# 'if' added by GJFB on 2022-06-11 - fieldName like %@usergroup should not be treated as having blank line (for such field, the blanks ( ) are not removed at submit - see function ProcessSubmit)
# in field like resumeid, orcid, group, affiliation and electronicmailaddress some lines might be empty
set value [join $value \;\n] ;# added by GJFB on 2022-01-25 - preserves empty lines, otherwise they are lost in the form - line originally empty in metadata (e.g. resumeid) must contain a blank ( ) to be displayed correctly in textarea (this blank is removed at submit - see function ProcessSubmit)
} else {
if 1 {
# added by GJFB on 2022-08-04 to fix metadata updated between 2022-01-25 and 2022-06-11 and in Archive with URLibService not updated after 2022-06-11
if [regexp {%@usergroup|%@readergroup} $fieldName] {
# puts --$value--
set nbsp [format %c 160] ;# no-break space
set value [lsort -unique [regsub -all $nbsp $value {}]] ;# drop no-break spaces and duplicates
}
}
set value [join $value \n]
}
# puts 2--$value--
}
} else {
# puts $value
## set value [join $value] ;# doesn't work - lost quotes (")
# regsub -all {"} $value {\"} value ;# " -> " - " leads to problem in INPUT VALUE
# puts $value
if {[string equal {Archival Unit} $referenceType] && [string equal {contents} $label]} {
# contents
catch { ;# added by GJFB on 2025-07-03 to overcome error like 'CreateMirror (5): list element in braces followed by "{Teses" instead of space' #}
set contentsList {}
foreach {searchExpression title} $value {
lappend contentsList [list $searchExpression $title]
}
set value [join $contentsList \n] ;# added by GJFB on 2013-04-13
}
}
if [regexp $multipleLineReferFieldNamePattern $fieldName] {
# multipleLineReferFieldNamePattern - multipleLineReferFieldNamePattern2 ( = nexthigheunit or previouslowerunit)
if [regexp {^(1.1|4)$} $fieldTypeNumber] {
set value [join $value \n]
}
}
}
# if [regexp {^%T} $fieldName] {
## hide $ in title, ex: cr$30
# regsub -all {\$} $value {\\\\\\\$} value ;# cr$30 -> cr\$30
# }
} elseif {$update && [info exists reviewArray($repName,$fieldName)]} {
set value $reviewArray($repName,$fieldName)
} else {
if {[regexp {%A|%@resumeid|%@orcid|%@group|%@affiliation|%@electronicmailaddress} $fieldName] && \
[info exists displayTable($referenceType,$fieldName)] && \
[regexp {2.1} [lindex $displayTable($referenceType,%A) 0]] && \
![string equal {Resume} $referenceType] && \
([regexp {%A} $fieldName] || \
([regexp {%@resumeid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@orcid} $fieldName] && [regexp {^(2.1|4)$} $fieldTypeNumber]) || \
([regexp {%@group} $fieldName] && [regexp {^(2.1|3)$} $fieldTypeNumber]) || \
([regexp {%@affiliation} $fieldName] && [regexp {2.1} $fieldTypeNumber]) || \
([regexp {%@electronicmailaddress} $fieldName] && [regexp {2.1} $fieldTypeNumber]))} {
# multiple creator fields
set value {{}}
} else {
set value {}
}
}
# puts --$value--
regsub -all {"} $value {\"} value ;# " -> " - " leads to problem in INPUT VALUE
# regsub -all {\$} $value {\\\\\\$} value ;# $ -> \\\\\\$ ($w$-operator)
# puts $referenceType,$fieldName
# puts [info exists displayTable($referenceType,$fieldName)]
if [info exists displayTable($referenceType,$fieldName)] {
# Process check box type entry
if {$fieldTypeNumber == 2.2} {
# 2.2
# checkbox
set value [TurnIntoList $value]
}
# Process check box type entry - end
# puts "$field = $value"
if [string equal {} $value] {
# set default value (from displayTable)
# set value [lindex $displayTable($referenceType,$fieldName) 2] ;# commented by GJFB on 2016-06-05
set value [lindex $displayValue 2] ;# added by GJFB on 2016-06-05
# puts "$field = $value"
} else {
# puts 1-$value
## use fifteen \ before square brackets (1 + 2 + 4 + 8 = 15 (there are four substitutions)
## in regsub we must double the number of \, that is we need thirty \.
# regsub -all {\[} $value {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\[} value
# regsub -all {\]} $value {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\]} value
# use three \ before square brackets (1 + 2 = 3 (there are two substitutions)
# in regsub we must double the number of \, that is we need six \.
# regsub -all {\[} $value {\\\\\\[} value ;# removed by GJFB on 2010-11-26 - doesn't work when using square bracket in the abstract field (e.g., [1])
# regsub -all {\]} $value {\\\\\\]} value ;# removed by GJFB on 2010-11-26 - doesn't work when using square bracket in the abstract field (e.g., [1])
# puts 2-$value
}
if [string equal {readpermission} $label] {
if [string equal {Journal Article} $referenceType] {
if [regexp {deny} $value] {
set value intranet
}
} else {
set value2 [ReturnAllowedIPList $value]
if [regexp {^[\d. ]+$} $value2] {
set value intranet
} else {
set value $value2
}
}
}
}
# puts --$value--st }}
2 {return {2nd }}
3 {return {3rd }}
default {return "$numberth "}
}
} else {
switch $number {
1 {return {1st}}
2 {return {2nd}}
3 {return {3rd}}
default {return "${number}th"}
}
}
}
pt-BR {return "$number°"}
default {return $number}
}
}
# CreateOrdinalNumber - end
# ----------------------------------------------------------------------