}
} else {
# set chekBoxCode " "
set chekBoxCode "
❘
"
}
ConditionalSet searchExpression parameterArray(searchexpression) "nexthigherunit, $identifier" ;# added by GJFB in 2015-06-21 - otherwise can't read "searchExpression": no such variable (with wrong password)
ConditionalSet choice parameterArray(choice) briefTitleAuthorMisc ;# added by GJFB in 2015-06-21 - otherwise can't read "choice": no such variable (with wrong password)
ConditionalSet outputFormat parameterArray(outputformat) ref-year-cite ;# added by GJFB in 2015-06-21 - otherwise can't read "outputFormat": no such variable (with wrong password)
# Check password - end
} else {
# Header
# puts "2 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
array set parameterArray $parameterlist
set jqueryCode {}
set message {}
# array set creativeCommonsRepositoryArray {urlib.net/www/2012/11.12.15.19 {CC BY-NC-ND} urlib.net/www/2012/11.12.15.15 {CC BY-NC-SA} urlib.net/www/2012/11.12.15.10 {CC BY-NC} urlib.net/www/2012/11.12.15.03 {CC BY-ND} urlib.net/www/2012/11.12.14.48 {CC BY-SA} urlib.net/www/2012/11.12.14.05 {CC BY} urlib.net/www/2012/11.12.20.35 CC0} ;# used in mirror/xxCover.tcl - commented by GJFB in 2023-12-12
array set creativeCommonsRepositoryArray {urlib.net/www/2012/11.12.15.19 {CC BY-NC-ND 3.0} urlib.net/www/2023/12.20.03.49 {CC BY-NC-ND 4.0} urlib.net/www/2012/11.12.15.15 {CC BY-NC-SA 3.0} urlib.net/www/2023/12.20.03.47 {CC BY-NC-SA 4.0} urlib.net/www/2012/11.12.15.10 {CC BY-NC 3.0} urlib.net/www/2023/12.20.03.45 {CC BY-NC 4.0} urlib.net/www/2012/11.12.15.03 {CC BY-ND 3.0} urlib.net/www/2023/12.20.03.39 {CC BY-ND 4.0} urlib.net/www/2012/11.12.14.48 {CC BY-SA 3.0} urlib.net/www/2023/12.20.03.32 {CC BY-SA 4.0} urlib.net/www/2012/11.12.14.05 {CC BY 3.0} urlib.net/www/2023/12.12.20.50 {CC BY 4.0} urlib.net/www/2012/11.12.20.35 CC0} ;# used in mirror/xxCover.tcl - added by GJFB in 2023-12-12
if {[string equal {Journal Article} $referencetype] && ![string equal {} $size]} {
if $standaloneModeFlag {
# in standalone mode
set useURLibServerFlag 0
} else {
set useURLibServerFlag 1 ;# avoid waiting for nonexisting repository in the local scope
}
set repositoryName dpi.inpe.br/banon-pc3/2011/03.14.15.45 ;# contains the file year=_issn_termsofuse.tcl
set tclFileName year=_issn_termsofuse.tcl ;# file defining the terms of use of the journal having issn
# puts OK
# puts "$repositoryName $tclFileName $useURLibServerFlag"
# =>
# dpi.inpe.br/banon-pc3/2011/03.14.15.45 year=_issn_termsofuse.tcl 1
# puts "" ;# to have the above puts displayed at once
catch {SetAttributeTable $repositoryName $tclFileName $useURLibServerFlag} m ;# set attributeTable using the Source procedure - the Source procedure was updated by GJFB in 2018-02-12 to turn around a long time-out of http::geturl when a firewall is set up
# puts --$m--
# puts OK2
# puts "" ;# to have the above puts displayed at once
}
ConditionalSet termsOfUse attributeTable(year=,issn,termsofuse,[lindex $issn 0]) {}
# puts --$termsOfUse--
set simplifiedRightsholder {}
# if [info exists creativeCommonsRepositoryArray($copyright)] #
if ![string equal {} $rightsholder] {
array set rightsholderArray $rightsholder
if {[info exists rightsholderArray(originalauthor)] && [string equal {yes} $rightsholderArray(originalauthor)]} {
# yes
set simplifiedRightsholder ${the original author}
} else {
# no
if [info exists rightsholderArray(name)] {
set simplifiedRightsholder $rightsholderArray(name)
}
}
}
# #
# puts $referencetype
if {0 && [regexp {^(Archival Unit|Misc)$} $referencetype]} { ;# commented by GJFB in 2024-01-10 - now searchSite2 and searchMirror2 are defined above to be used also with AdvancedUserHeader, otherwise one gets the erro: can't read "searchSite2": no such variable, when the password field is empty and the + button is pressed
# site is obtained from documentserveraddress which is obtained from urlPropertyArray(archiveaddress)
# set searchSite $site ;# use site instead - the search site should not be the resolver site, it must be the site of the archival unit (for example bibdigital.sid.inpe.br and not www.urlib.net) otherwise the search may not refer to the archival unit content - commented by GJFB in 2022-08-20
set searchSite2 $site ;# use site instead - the search site should not be the resolver site, it must be the site of the archival unit (for example bibdigital.sid.inpe.br and not www.urlib.net) otherwise the search may not refer to the archival unit content - added by GJFB in 2022-08-20 - searchSite value must be preserved
# set searchMirror $documentMirrorRep ;# use documentMirrorRep instead - the search mirror should not depend on the mirror of the resolver site, it must depend on the site of the archival unit (for example bibdigital.sid.inpe.br and not www.urlib.net) otherwise the search may not refer to the archival unit content - commented by GJFB in 2022-08-20
set searchMirror2 $documentMirrorRep ;# use documentMirrorRep instead - the search mirror should not depend on the mirror of the resolver site, it must depend on the site of the archival unit (for example bibdigital.sid.inpe.br and not www.urlib.net) otherwise the search may not refer to the archival unit content - added by GJFB in 2022-08-20 - searchMirror value must be preserved
} elseif {[regexp {^(Conference Proceedings)$} $referencetype]} {
set siteList [FindSiteList $documentMirrorRep $site $documentServerAddress]
if [string equal {} $identifier] {
set numberOfSupplementaryMaterial 0 ;# added by GJFB in 2021-09-12 - when an old record doesn't yet have an identifier, the search expression "nexthigherunit" might return a non-empty result
} else {
set searchExpression "nexthigherunit $identifier"
set query [list list GetMetadataRepositories {} 0 $searchExpression yes yes 1]
set searchResultList {}
MultipleSubmit {} $query searchResultList 0 $siteList ;# level == 1
set numberOfSupplementaryMaterial [llength [lsort -unique $searchResultList]]
}
# puts $numberOfSupplementaryMaterial
}
ConditionalSet searchExpression parameterArray(searchexpression) "nexthigherunit, $identifier"
ConditionalSet choice parameterArray(choice) briefTitleAuthorMisc
ConditionalSet outputFormat parameterArray(outputformat) ref-year-cite
# puts --$searchExpression--
if [info exists cgi(numberofrecords)] {
set numberOfRecords $cgi(numberofrecords)
set digitalStorageIndicator $cgi(digitalstorageindicator)
} else {
# puts "3 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
# Compute numberOfRecords
if {[info exists parameterArray(searchexpression)] || [string equal {Archival Unit} $referencetype]} {
set currentRep2 $currentRep ;# preserve currentRep
# set currentRep $searchMirror ;# used MultipleSubmit - commented by GJFB in 2022-08-20
set currentRep $searchMirror2 ;# used MultipleSubmit - added by GJFB in 2022-08-20
if 0 {
# old code - excludes copies
# set query [list list GetMetadataRepositories {} 5 "nexthigherunit, $identifier" yes yes 1]
set query [list list GetMetadataRepositories {} 5 "nexthigherunit, $identifier and hostcollection, *" yes yes 1]
global searchResultList
set searchResultList {}
MultipleSubmit {} $query searchResultList 0 ;# level == 1
set numberOfRecords 0
foreach i $searchResultList {incr numberOfRecords $i}
} else {
# new code - counts original and copies
# puts [file isdirectory $homePath/col/$documentMirrorRep]
if ![info exists siteList] {set siteList [FindSiteList $documentMirrorRep $site $documentServerAddress]}
# global searchResultList ;# removed by GJFB in 2021-08-31
# puts --$siteList--
set query [list list GetMetadataRepositories {} 0 $searchExpression yes yes 1]
# puts $query
set searchResultList {}
MultipleSubmit {} $query searchResultList 0 $siteList ;# level == 1
set numberOfRecords [llength [lsort -unique $searchResultList]]
set query [list list GetMetadataRepositories {} 0 "$searchExpression and size *" yes yes 1]
set searchResultList {}
MultipleSubmit {} $query searchResultList 0 $siteList ;# level == 1
set numberOfFullText [llength [lsort -unique $searchResultList]]
if {$numberOfRecords > 0} {
set digitalStorageIndicator [expr 100 * $numberOfFullText / $numberOfRecords]%
} else {
set digitalStorageIndicator - ;# undefined
}
}
set currentRep $currentRep2 ;# restore currentRep
} else {
set numberOfRecords 0 ;# added by GJFB in 2022-06-16 - Misc reference type (ex: Tcl Page for Author Index) only displays the number of information itens and the search field if the parameterlist field contains a search expression (ex: id 3ERPFQRT3W/38BF6CH)
set digitalStorageIndicator -
}
# Compute numberOfRecords - end
# puts "4 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
}
# puts $numberOfRecords
} ;# specific Header - end
# window
regsub -all {/} ${mirror}___$cgi(metadatarepository) {__} window
regsub -all {\.|@|-} $window {_} window
set window ${window}___0
if [string equal {} $identifier] {
if [catch {ConvertFromRepository [string tolower $currentRep]} identifier] {
# identifier syntax error
# currentRep == cptec.inpe.br/adm_conf/2005/10.31.12.09 (ICSHMO)
# can't read "inverseDigitArray(_)": no such element in array
set identifier {} ;# added by GJFB in 2010-12-27
}
}
# identifier is just used to display the IBI (ibip or ibin)
# noAccessRestrictionFlag
set noAccessRestrictionFlag [ComputeAccessRestrictionFlag $readpermission $env(REMOTE_ADDR)] ;# used in mirror/xxCover.tcl
array set bookTitleXreferenceTypeArray {
Abstracts {Conference Abstract}
Resumos {Conference Abstract}
Abstracts/Posters {Conference Abstract/Poster}
Resumos/Pôsteres {Conference Abstract/Poster}
{Extended Abstracts} {Conference Extended Abstract}
{Resumos Extendidos} {Conference Extended Abstract}
Posters {Conference Poster}
Pôsteres {Conference Poster}
Videos {Conference Video}
Vídeos {Conference Video}
}
# puts $referencetype
if [regexp {^(Conference Proceedings|Audiovisual Material)$} $referencetype] {
if [string equal {} $booktitle)] {
set value $translationTable($referencetype)
} else {
if [info exists bookTitleXreferenceTypeArray($booktitle)] {
set value $translationTable($bookTitleXreferenceTypeArray($booktitle))
} else {
set value $translationTable($referencetype)
}
}
} else {
set value $translationTable($referencetype)
}
# referenceType (used in mirror/xxCover.tcl)
# regsub -all { } $translationTable($referencetype) {\ } referenceType ;# commented by GJFB in 2021-01-17
regsub -all { } $value {\ } referenceType ;# added by GJFB in 2021-01-17
# referenceType2
regsub -all { } $referencetype {+} referenceType2
set linkForHide http://$bodyLink2
# documentserverAddress2
regsub { +} $documentServerAddress {+} documentServerAddress2
# howToCite
# puts http://$site/$cgi(metadatarepository)?ibiurl.language=$selectedLanguageFromMirror&ibiurl.metadataformat=BibINPE
# => http://gjfb/iconet.com.br/banon/2006/10.21.11.08.17?ibiurl.language=pt-BR&ibiurl.metadataformat=BibINPE
# http://gjfb/col/iconet.com.br/banon/2006/10.21.11.08.17/doc/metadata.cgi?choice=fullBibINPE
if {[info exists env(BIBINPE_REP)] && [regexp {^(Journal Article|Book|Book Section|Edited Book|Newspaper|Newspaper Article|Conference Proceedings|Thesis|Report|Electronic Source|Audiovisual Material|Film or Broadcast|Misc|Archival Unit|Administrative Document)$} $referencetype]} {
regsub -all { } $translationTable(How to cite?) {\ } anchor
# set howToCite "$anchor"
# set howToCite "$anchor"
# set howToCite "$anchor"
# set howToCite "$anchor" ;# ibiurl.language is alias for languagebutton
# set howToCite "$anchor" ;# ibiurl.language is alias for languagebutton
# set howToCite "$anchor" ;# ibiurl.language is alias for languagebutton
# set howToCite "$anchor"
set howToCite "$anchor"
} else {
set howToCite {}
}
# size and size2
set size [lindex $size 0]
if {$size <= 1} {
global "${languageRep2}::Kbyte"
set size2 "$size $Kbyte"
} else {
global "${languageRep2}::Kbytes"
set size2 "$size $Kbytes"
}
set cgi(wrongpassword) {no}
if $oldCode {
# commented by GJFB in 2017-03-19 - doesn't work with http://gjfb.home:1905/rep/8JMKD3MGP3W34P/3MPQ9AE because m21b has the port 804 closed for the rest of the world
SetFieldValue $documentServerAddress $cgi(metadatarepository)-0 {repository metadatarepository metadatalastupdate nexthigherunit shorttitle}
} else {
# added by GJFB in 2017-03-19
# set fieldNameList3 {repository metadatarepository metadatalastupdate nexthigherunit shorttitle}
set pairList {}
foreach item3 $fieldNameList3 {
set $item3 $cgi($item3)
}
}
# puts [encoding system]
# => iso8859-1 using gjfb0520
if [file exists $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl] {
# SOURCE returnPathArray.tcl (Header|AdvancedUserHeader)
catch { ;# catch added by GJFB in 2023-03-12 - for some reason returnPathArray.tcl might be corrupted and must be recreated
source $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl ;# set returnPathArray - added by GJFB in 2021-05-22 - returnPathArray.tcl may exist after a first load of the header - used in mirror/xxCover.tcl to have (<) displayed
}
}
if [file exists $homePath/clipboard3/$currentRep/auxdoc/missingNextHigherUnitIBIList.txt] {
Load $homePath/clipboard3/$currentRep/auxdoc/missingNextHigherUnitIBIList.txt missingNextHigherUnitIBIList
set color #D52A2A ;# see "list of missing next higher units" in the source code of the menu bar
set doubleClickColor #D52A2A
} else {
set missingNextHigherUnitIBIList {}
# set color #000000 ;# commented by GJFB in 2022-06-14
set color #119911 ;# added by GJFB in 2022-06-14 to highlight the return button <
# set doubleClickColor blue ;# added by GJFB in 2022-06-14 to highlight the return button < for double click
set doubleClickColor #119911 ;# added by GJFB in 2022-06-14 to highlight the return button < for double click
}
# puts $color
# set output [subst $Header]
# puts --$shorttitle--
# puts "5 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
# PUTS HEADER (menu bar: Header|AdvancedUserHeader)
puts [subst $Header]
# puts "6 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
puts "" ;# to have the menu displayed at once - this has been working with urlib.net only after creating an id (IBIn) for loCoInRep
if 0 {
# commented by GJFB in 2019-03-23 - time consuming - after 2017-03-19 a pink "<" button alerts the user to missing next higher units - correctives measures should be done manually instead (for exemplo when a missing next higher unit is defined in a record copy)
# Check for deleted next higher unit
# added by GJFB in 2014-08-02
foreach unit $nexthigherunit {
set parsedIBIURL [list parsedibiurl.ibi $unit]
set condition [expr $agencyStructureFlag && ([string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]) && [string equal {} $queryString] && ![regexp {[\w/@.]+[!+:]} $pathInfo]]
# >>> for testing
# set condition [expr $agencyStructureFlag && [string equal {} $queryString]] ;# for testing
if $condition {
# try using the agency structure
# agency structure specific code
# www.urlib.net resolver running
set urlPropertyList [CreateListOfurlPropertiesFromAgencies $parsedIBIURL $selectedLanguageFromMirror $languageRep1 $languageRep2 $localSite]
set agencyStructureFlag2 1 ;# agency structure used
} else {
set agencyStructureFlag2 0 ;# agency structure not used
}
if {!$agencyStructureFlag2 || ([info exists urlPropertyList] && [string equal {} $urlPropertyList])} {
# agency structure disabled or not used or fails to connect to all agencies and to find the url properties of the ibi
# not agency structure specific code
# any resolvers (www.urlib.net or agency resolvers) running
# agency resolver running
set displayWarningMessage 0
set useURLibServerFlag 0 ;# try locally first
# RESOLVEIBI
# set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} $useURLibServerFlag] ;# commented by GJFB in 2017-02-20
set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} $useURLibServerFlag $agencyStructureFlag] ;# added by GJFB in 2017-02-20
}
# puts --$urlPropertyList--
if ![string equal {} $urlPropertyList] {
array set urlPropertyArray $urlPropertyList
set state $urlPropertyArray(state)
if [string equal {Deleted} $state] {
# puts $state
# Update nexthigherunit field
# similar code in DisplayDocContent
# SetFieldValue $documentServerAddress $cgi(metadatarepository)-0 {repository metadatarepository metadatalastupdate nexthigherunit}
if [Execute $documentServerAddress [list GetDocumentState $repository]] {
# the document is the original
## loCoInRep
# set loCoInRep $env(LOCOINREP)
# codedPassword
Load $homePath/col/$loCoInRep/auxdoc/xxx data binary
set data [UnShift $data]
set codedPassword [lindex $data end]
set command [list list CheckPassword administrator $codedPassword] ;# codedPassword should be the same for all sites
set flag [MultipleExecute [list $documentServerAddress] $command]
if {[string equal {} $flag] || $flag} {continue} ;# wrong password
Execute $documentServerAddress [list WaitQueue2 Get {} $codedPassword] 0 ;# not async
# multipleLineReferFieldNamePattern
set multipleLineReferFieldNamePattern $env(MULI_PATTERN) ;# used by GetReferField (called by CreateVersionStamp called by ChangeFieldValue)
set metadataList {} ;# for add
set metadata2List {} ;# for remove
set repositoryList {}
set fieldNameList nexthigherunit
set oldFieldValueList [list $nexthigherunit]
set index [lsearch $nexthigherunit $unit]
set newNextHigherUnit [lreplace $nexthigherunit $index $index]
set newFieldValueList [list $newNextHigherUnit]
set rangeList {{}}
set userName administrator
ChangeFieldValue $documentServerAddress $metadatarepository $metadatalastupdate $fieldNameList $oldFieldValueList $newFieldValueList $rangeList $userName $codedPassword ;# changes metadataList and metadata2List
lappend repositoryList $repository $metadatarepository
if 0 {
# commented by GJFB in 2020-08-18
Execute $documentServerAddress [list RemoveMetadata $metadata2List]
Execute $documentServerAddress [list AddMetadata $metadataList]
} else {
Execute $documentServerAddress [list UpdateMetadata $metadata2List $metadataList] ;# added by GJFB in 2020-08-18 - uses metadata2List and metadataList
}
Execute $documentServerAddress [list UpdateRepositoryListForPost $repositoryList]
Execute $documentServerAddress [list LeaveQueue] 0 ;# not async
}
# Update nexthigherunit field - end
}
}
}
# Check for deleted next higher unit - end
}
# (< or <<) is displayed in the menu bar
# puts --$shorttitle-- ;# to see the puts message, see the bottom part of the source code of the menu bar (no other steps are required)
# puts [expr ![info exists cgi(forcehistorybackflag)] || !$cgi(forcehistorybackflag)]
if {![info exists cgi(forcehistorybackflag)] || !$cgi(forcehistorybackflag)} { ;# if added by GJFB in 2022-12-30 to avoid unnecessary computing
# set timePeriod 1 ;# 1 seconds
set timePeriod [expr 24*60*60] ;# 1 day
set filePath $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl
set updateFlag [ComputeFileUpdateFlag $filePath $timePeriod]
if $updateFlag { ;# if added by GJFB in 2023-01-14
# STORERETURNPATHARRAY (uses BuildReturnPathArray)
StoreReturnPathArray $nexthigherunit $shorttitle $agencyStructureFlag $currentRep ;# same code in CreateFullEntry
}
}
# puts [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]
return
} ;# Header|AdvancedUserHeader - end
{Return} {
# RETURN
# v
# return to root (ex: < 1-> < 2-> < 3-> >) (> and possibly <) are displayed in the menu bar
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}Cover.tcl ;# {turn the attached file, the target file}
global "${languageRep2}::Return" ;# uses languageRep1
# global "translationTable" ;# set in mirror/xxCover.tcl
global "${languageRep2}::translationTable" ;# set in mirror/xxCover.tcl
# puts [array get cgi]
# currentRep (the repository of the current ibi)
set currentRep $cgi(currentrep)
ConditionalSet queryValue cgi(query) {}
ConditionalSet userName cgi(username) {}
ConditionalSet codedPassword1 cgi(codedpassword1) {}
set documentServerAddress $cgi(documentserveraddress)
set termsOfUse $cgi(termsofuse)
set simplifiedRightsholder $cgi(simplifiedrightsholder)
set returnPathNumber $cgi(returnpathnumber)
set numberOfRecords $cgi(numberofrecords)
set digitalStorageIndicator $cgi(digitalstorageindicator)
set waitForCompletionFlag $cgi(waitforcompletionflag)
# agencyStructureFlag
set agencyStructureFlag $cgi(agencystructureflag)
# progressKey
ConditionalSet progressKey cgi(progresskey) {}
# searchInputValue
ConditionalSet searchInputValue cgi(searchinputvalue) {} ;# added by GJFB in 2022-06-13 - value is a search expression
# parentIdentifierCitedBy
ConditionalSet parentIdentifierCitedBy cgi(parentidentifiercitedby) {} ;# added by GJFB in 2022-06-13
set parentIdentifierCitedBy1 [lindex $parentIdentifierCitedBy 0] ;# added by GJFB in 2023-03-10 - now parentIdentifierCitedBy can be a list - see example of list in localIndexInOnePage.html - used when linkType is 1 and targetValue is _top
set parentIdentifierCitedBy2 [lrange $parentIdentifierCitedBy 1 end] ;# added by GJFB in 2023-03-10 - now parentIdentifierCitedBy can be a list - see example of list in localIndexInOnePage.html - used when linkType is 1 and targetValue is _top
# forceRecentFlag
ConditionalSet forceRecentFlag cgi(forcerecentflag) 0 ;# added by GJFB in 2022-06-13 - used in the mirror home page file - value is 0 (default) or 1 (means to force 'The Most Recent' display)
# forcehistorybackflag
ConditionalSet forceHistoryBackFlag cgi(forcehistorybackflag) 1 ;# added by GJFB in 2023-06-09 used in 'Guia do administrador' (8JMKD3MGP5W34M/3FU99GE) - value is 0 or 1 (default - means to force the display of the 'history.back' arrow)
set bodyLink $cgi(bodylink)
# migration 2018-03-30
file delete $homePath/col/$currentRep/auxdoc/returnPathArray.tcl
# migration 2018-03-30 - end
# puts [encoding system]
# => iso8859-1 using gjfb0520
if [file exists $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl] {
# SOURCE returnPathArray.tcl (Return)
source $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl ;# set returnPathArray
SetFieldValue $documentServerAddress $cgi(metadatarepository)-0 {nexthigherunit}
} else {
if $oldCode {
# commented by GJFB in 2017-03-19 - doesn't work with http://gjfb.home:1905/rep/8JMKD3MGP3W34P/3MPQ9AE because m21b has the port 804 closed for the rest of the world
SetFieldValue $documentServerAddress $cgi(metadatarepository)-0 {nexthigherunit shorttitle}
} else {
# added by GJFB in 2017-03-19
# set fieldNameList4 {nexthigherunit shorttitle}
set pairList {}
foreach item4 $fieldNameList4 {
set $item4 $cgi($item4)
}
}
# puts [list $nexthigherunit $shorttitle]
set i 1
set returnPathArrayList {}
set missingNextHigherUnitIBIList {}
# BUILDRETURNPATHARRAY (Return)
if [catch {BuildReturnPathArray [list {} $nexthigherunit $shorttitle] $agencyStructureFlag $i $returnPathArrayList $missingNextHigherUnitIBIList} buildOutput] {
global errorInfo
puts ""
} else {
foreach {i returnPathArrayList missingNextHigherUnitIBIList} $buildOutput {break}
array set returnPathArray $returnPathArrayList
}
}
# puts -1-[array get returnPathArray]--
# =>
# 1 {83LX3pFwXQZeBBx/BbsHa urlib.net {} {Documentação URLib}}
# other returnPathArray examples:
# 1 {3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}}
# 2 {3ERPFQRTRW34M/3E7G88S {SBSR 16} 3ERPFQRTRW34M/3EHNQ68 Indice {} {}}
# returnPathArray example:
# 1 {8JMKD3MGPCW/3DT298S INPE 83LX3pFwXQZ5Jpy/CxGU3 {Biblioteca SBSR} 3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}}
# 2 {8JMKD3MGPCW/3DT298S INPE 83LX3pFwXQZ5Jpy/CxGU3 {Biblioteca SBSR} 3ERPFQRTRW34M/3E7G88S {SBSR 16} 3ERPFQRTRW34M/3EHNQ68 Indice {} {}}
# 1 {8JMKD3MGPCW/3DT298S INPE 83LX3pFwXQZ5Jpy/CxGU3 {Biblioteca SBSR} 3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}}
# 2 {8JMKD3MGPCW/3DT298S INPE 83LX3pF putswXQZ5Jpy/CxGU3 {Biblioteca SBSR} 3ERPFQRTRW34M/3E7G88S {SBSR 16} 3ERPFQRTRW34M/3EHNQ68 Indice {} {} 8JMKD3MGPCW/3DT298S INPE 8JMKD3MGPCW/3EQCC85 Produção 8JMKD3MGPCW/3ER446E DSR 3ERPFQRTRW34M/3E7G88S {SBSR 16}}
# 3 {8JMKD3MGPCW/3DT298S INPE 8JMKD3MGPCW/3EQCC85 Produção 8JMKD3MGPCW/3EQCCU5 DPI 3ERPFQRTRW34M/3EHNQ68 Indice 8JMKD3MGPCW/3DT298S INPE 8JMKD3MGPCW/3EQCC85 Produção 8JMKD3MGPCW/3ER446E DSR 3ERPFQRTRW34M/3E7G88S {SBSR 16}}
# returnPathArray2 (contains the return path up to the root)
if 1 {
# Drop the paths contained in other paths
# added by GJFB in 2022-07-28
set nameList [array names returnPathArray]
array set returnPathArray2 [array get returnPathArray]
foreach name1 $nameList {
foreach name2 $nameList {
if [string equal $returnPathArray($name1) $returnPathArray($name2)] {continue}
set path1 [lrange $returnPathArray($name1) 0 end-2]
set path2 [lrange $returnPathArray($name2) 0 end-2]
if [regexp $path1 $path2] {
# path1 is stricly contained in path2
unset returnPathArray2($name1)
break
}
}
}
set nameList [array names returnPathArray2]
set j 1
foreach name $nameList {
set returnPathArray3($j) $returnPathArray2($name)
incr j
}
unset returnPathArray
array set returnPathArray [array get returnPathArray3]
# Drop the paths contained in other paths - end
}
set nameList [array names returnPathArray]
set numberOfReturnPaths [llength $nameList]
if 0 {
puts {Content-Type: text/html}
puts {}
}
# puts --$nameList--
# => --4 1 2 3--
set j 1
set greenFlag1 0
foreach i $nameList {
# puts --$returnPathArray($i)--
set greenFlag2 0
set returnPathArray2($i) {}
foreach {ibi shortTitle} $returnPathArray($i) {
if [string equal {} $ibi] {
lappend returnPathArray2($i) "$shortTitle"
} else {
# lappend returnPathArray2($i) "$shortTitle"
if {1 || [file exists $homePath/col/$loCoInRep/auxdoc/siteStampXcodedPasswordArray.tcl]} { ;# if added by GJFB in 2021-02-16 - commented in 2022-08-16 since siteStampXcodedPasswordArray.tcl now exists for all Archive (see LoadGlobalVariable)
set repName [Execute $serverAddress [list FindRepositoryNameFromIBI $ibi]] ;# added by GJFB in 2021-09-02
if [string equal {} $repName] {
# the record is not in the (local) collection
# if [string equal $ibi $parentIdentifierCitedBy] # ;# commented by GJFB in 2023-03-10
if [regexp $ibi $parentIdentifierCitedBy1] { ;# added by GJFB in 2023-03-10 - now parentIdentifierCitedBy can be a list - see example of list in localIndexInOnePage.html - used when linkType is 1 and targetValue is _top
# green background
if [string equal {} $cgi(searchinputvalue)] {
# lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
} else {
# lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
}
set greenFlag2 1
} else {
# lappend returnPathArray2($i) "$shortTitle" ;# ibiurl.backgroundlanguage is alias for languagebutton - commented by GJFB in 2022-07-28
lappend returnPathArray2($i) "$shortTitle" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2022-07-28 to avoid the double click option
}
} else {
# puts "--$ibi $parentIdentifierCitedBy1--"
# the record is in the (local) collection - useful alternative when the host has a dynamique IP. In that case, urlib.net would not be able to find any record in that local collection
# if [string equal $ibi $parentIdentifierCitedBy] # ;# commented by GJFB in 2023-03-10
if [regexp $ibi $parentIdentifierCitedBy1] { ;# added by GJFB in 2023-03-10 - now parentIdentifierCitedBy can be a list - see example of list in localIndexInOnePage.html - used when linkType is 1 and targetValue is _top
if [string equal {} $cgi(searchinputvalue)] {
# green background
# lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
} else {
# lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
lappend returnPathArray2($i) " $shortTitle " ;# added by GJFB in 2022-06-13
}
set greenFlag2 1
} else {
if {0 && [string equal $searchSiteIdentifier $parentIdentifierCitedBy1]} {
# green background - all links become green
lappend returnPathArray2($i) " $shortTitle " ;# ibiurl.backgroundlanguage is alias for languagebutton
set greenFlag2 1
} else {
# lappend returnPathArray2($i) "$shortTitle" ;# ibiurl.backgroundlanguage is alias for languagebutton - commented by GJFB in 2022-07-28
lappend returnPathArray2($i) "$shortTitle" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2022-07-28 to avoid the double click option
}
}
}
} else {
# something must probably be updated here - commented (see above) by GJFB in 2022-08-16
lappend returnPathArray2($i) "$shortTitle" ;# ibiurl.backgroundlanguage is alias for languagebutton
}
}
} ;# end of foreach
# puts --[array get returnPathArray2]--
if $greenFlag2 {
set returnPathArray4($j) $returnPathArray2($i)
set greenFlag1 1
incr j
}
if !$greenFlag1 {
if {$numberOfReturnPaths > 1} {
set returnPathArray2($i) "($i/$numberOfReturnPaths) - [join $returnPathArray2($i) { > }]"
} else {
set returnPathArray2($i) [join $returnPathArray2($i) { > }]
}
}
} ;# end of foreach
if 1 {
# Drop the paths without green highlight if there is at least one with green highlight
# added by GJFB in 2022-07-28
if $greenFlag1 {
unset returnPathArray2
set nameList [array names returnPathArray4]
set numberOfReturnPaths [llength $nameList]
foreach j $nameList {
if {$numberOfReturnPaths > 1} {
set returnPathArray2($j) "($j/$numberOfReturnPaths) - [join $returnPathArray4($j) { > }]"
} else {
set returnPathArray2($j) [join $returnPathArray4($j) { > }]
}
}
}
# Drop the paths without green highlight if there is at least one with green highlight - end
}
if {$returnPathNumber >= $numberOfReturnPaths} {
set returnAction $cgi(headertype)
set inputValue >
set inputTitle1 {go to the menu}
} else {
set returnAction Return
set inputValue <
set inputTitle1 {see the return path up to the root}
set inputTitle2 {click once to see return path to root - twice to return to the previous page} ;# added vy GJFB in 2022-06-13
}
# puts -2-[array get returnPathArray2]--
# =>
# 1 {urlib.net > Documentação URLib}
# puts $Return
# PUTS RETURN
set output [subst $Return]
}
Warning1 {
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}Cover.tcl ;# Header, wrong password, ...
global "${languageRep2}::Warning1" ;# uses languageRep1
set output [subst $Warning1]
}
Warning2 {
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}Cover.tcl ;# Header, wrong password, ...
global "${languageRep2}::Warning2" ;# uses languageRep1
set output [subst $Warning2]
}
default {
# FRAMESET
encoding system utf-8 ;# added by GJFB in 2015-01-09 to solve the accent problem with gjfb.home (Windows OS) when the filePath contains upper case accented letter (e.g., Ã) - must be just before creating pathInfo
# e.g., http://gjfb.home/rep/dpi.inpe.br/banon-pc2@80/2008/11.25.15.05/pasta/manuscrito VERSÃO 2.pdf
if [info exists env(PATH_INFO)] {
set pathInfo $env(PATH_INFO)
} else {
set pathInfo /
}
if [catch {ParseIBIURL $pathInfo $queryString} parsedIBIURL] {
# syntax error
# example: http://banon-pc3.dpi.inpe.br/rep/LK47B6/362SFKI
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}Cover.tcl
catch {subst [set [list ${languageRep2}::syntax error]]} output
error $output
}
if 0 {
puts {Content-Type: text/html}
puts {}
puts --$pathInfo--
puts --$queryString--
puts --$parsedIBIURL--
}
array set ibiURLArray $parsedIBIURL
# file
set file $ibiURLArray(parsedibiurl.filepath) ;# used in header - used to decide to count one click only
if $oldCode {
# commented by GJFB in 2017-03-19
} elseif 0 {
# added by GJFB in 2017-03-19 - commented by GJFB in 2022-02-22
# parsedibiurl.metadatafieldnamelist already exists and might be empty (see ParseIBIURL)
lappend parsedIBIURL parsedibiurl.metadatafieldnamelist $fieldNameListAll
} else {
# added by GJFB in 2022-02-22
set fieldNameList2 [concat $ibiURLArray(parsedibiurl.metadatafieldnamelist) $fieldNameListAll]
set ibiURLArray(parsedibiurl.metadatafieldnamelist) [lsort -unique $fieldNameList2]
set parsedIBIURL [array get ibiURLArray]
}
# Create urlPropertyList2
# set agencyStructureFlag 0 ;# disable agency structure
set agencyStructureFlag 1 ;# enable agency structure - don't use urlib.net resolution - agencyStructureFlag must be set also in CreateFullEntry
set condition [expr $agencyStructureFlag && ([string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]) && [string equal {} $queryString] && ![regexp {[\w/@.]+[!+:]} $pathInfo]]
# >>> for testing
# http://vaio:1905/rep/urlib.net/www/2017/07.08.14.36
# set condition [expr $agencyStructureFlag && [string equal {} $queryString] && ![regexp {[\w/@.]+[!+:]} $pathInfo]] ;# for testing
# set condition [expr $agencyStructureFlag && [file exists $homePath/col/$loCoInRep/auxdoc/agencyHTTPHostList.tcl] && [string equal {} $queryString]] ;# for future use - for more than two resolver layers
# set condition [expr $agencyStructureFlag && [file exists $homePath/col/$loCoInRep/auxdoc/agencyHTTPHostList.tcl] && [string equal {} $queryString]] ;# for future use - for more than two resolver layers
# puts $agencyStructureFlag
# puts --$queryString--
if 0 {
puts {Content-Type: text/html}
puts {}
puts "condition = $condition"
puts "parsedIBIURL = $parsedIBIURL"
puts "selectedLanguageFromMirror = $selectedLanguageFromMirror"
puts "languageRep1 = $languageRep1"
puts "languageRep2 = $languageRep2"
puts "localSite = $localSite"
}
if $condition {
# agency structure specific code
# www.urlib.net resolver running
# use of the HTTP protocol
# puts "parsedIBIURL = $parsedIBIURL"
set urlPropertyList2 [CreateListOfurlPropertiesFromAgencies $parsedIBIURL $selectedLanguageFromMirror $languageRep1 $languageRep2 $localSite]
# puts "urlPropertyList2 = --$urlPropertyList2--"
set agencyStructureFlag2 1 ;# agency structure used
} else {
set agencyStructureFlag2 0 ;# agency structure not used
}
if {!$agencyStructureFlag2 || ([info exists urlPropertyList2] && [string equal {} $urlPropertyList2])} {
# agency structure disabled or not used or fails to connect to all agencies and find the url properties of the ibi
# not agency structure specific code
# any resolvers (www.urlib.net or agency resolvers) running
# agency resolver running
# >>> step 1 (output) 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 displayWarningMessage 1 ;# commented by GJFB in 2017-02-20
set displayWarningMessage [string equal {content} $ibiURLArray(parsedibiurl.returntype)] ;# added by GJFB in 2017-02-20 - agency structure communication
# puts [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]
# set urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage $currentProcedureName] ;# commented by GJFB in 2017-02-20
set useURLibServerFlag 0 ;# try locally first
if 0 {
puts {Content-Type: text/html}
puts {}
puts --$parsedIBIURL--
}
# RESOLVEIBI
set urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage $currentProcedureName $useURLibServerFlag $agencyStructureFlag] ;# added by GJFB in 2017-02-20
# puts [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]
if 0 {
puts {Content-Type: text/html}
puts {}
puts --$urlPropertyList2--
}
# set xxx 1-$urlPropertyList2
# Store xxx C:/tmp/bbb.txt binary 0 a
}
# Create urlPropertyList2 - end
array set urlPropertyArray $urlPropertyList2
# site (document site)
set site $urlPropertyArray(archiveaddress)
# puts $site
# => www.urlib.net
# puts $localSite
# => www.urlib.net:80
if $redirectFlag {
# added by GJFB in 2021-05-23
if [string equal $site [regsub {:80$} $localSite {}]] {
puts {Content-Type: text/html}
puts {}
} else {
# REDIRECT
puts "Location: http://$site$env(REQUEST_URI)"
puts {}
return
}
}
# puts --$urlPropertyList2--
# puts {}
# puts [array names urlPropertyArray]
# puts {}
# puts $urlPropertyArray(metadatafieldlist)
# documentServerAddress
set documentServerAddress [GetServerAddressFromHTTPHost $site]
# url
set url $urlPropertyArray(url)
# puts $url
# regsub {http://} $url {} link
# state - used in header
set state $urlPropertyArray(state)
# currentRep - used in header
# set currentRep [Execute $documentServerAddress [list FindRepositoryNameFromIBI $urlPropertyArray(ibi)]]
array set ibiArray $urlPropertyArray(ibi)
set currentRep $ibiArray(rep)
# puts $documentServerAddress
# puts $currentRep
# puts $cgi(metadatarepository)
if $oldCode {
# commented by GJFB in 2017-03-19 - doesn't work with http://gjfb.home:1905/rep/8JMKD3MGP3W34P/3MPQ9AE because m21b has the port 804 closed for the rest of the world
# metadataRep
if [info exists cgi(metadatarepository)] {
set metadataRep $cgi(metadatarepository)
# set metadataRepPlus $metadataRep
} else {
# currentRep must not be a metadata repository otherwise FindMetadataRep returns empty
# set metadataRep [Execute $documentServerAddress [list FindMetadataRep $currentRep]] ;# returns the one which is not a metadata translation
set metadataFlag [Execute $documentServerAddress [list TestContentType $currentRep Metadata]]
if {[string equal {} $metadataFlag] || $metadataFlag} {
# currentRep is a metadata repository
set metadataRep $currentRep ;# involution
} else {
set metadataRep [Execute $documentServerAddress [list FindMetadataRep $currentRep $selectedLanguageFromMirror]]
}
}
# puts --$metadataRep--
# SET FIELD VALUES
# SetFieldValue $documentServerAddress $metadataRep-0 {title targetfile referencetype fullname}
# SetFieldValue $documentServerAddress $metadataRep-0 {title targetfile referencetype fullname contenttype}
# SetFieldValue $documentServerAddress $metadataRep-0 {title targetfile referencetype fullname contenttype username} ;# added by GJFB in 2017-03-19, targetfile is used in a hidden code in mirror/xxCover.tcl - commented by GJFB in 2022-05-09
SetFieldValue $documentServerAddress $metadataRep-0 {title targetfile referencetype fullname contenttype username versiontype} ;# added by GJFB in 2022-05-09 - versiontype
} else {
# added by GJFB in 2017-03-19
ConditionalSet metadataFieldList urlPropertyArray(metadatafieldlist) {}
foreach {metadataFieldName metadataFieldValue} $metadataFieldList {
set $metadataFieldName $metadataFieldValue ;# set title, targetfile, referencetype, fullname, ..., readpermission, ...
}
# set metadataRep $metadatarepository
}
# new code - equal to the code in Get- - added 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)
# searchinputvalue
ConditionalSet searchinputvalue cgi(searchinputvalue) {} ;# added by GJFB in 2022-06-13 - value is a search expression
# parentidentifiercitedby
ConditionalSet parentidentifiercitedby cgi(parentidentifiercitedby) {} ;# added by GJFB in 2022-06-13
# forcerecentflag
ConditionalSet forcerecentflag cgi(forcerecentflag) 0 ;# added by GJFB in 2022-06-13 - used in the mirror home page file - value is 0 (default) or 1 (means to force 'The Most Recent' display)
# forcehistorybackflag
ConditionalSet forcehistorybackflag cgi(forcehistorybackflag) 1 ;# added by GJFB in 2022-12-02 used in 'Guia do administrador' (8JMKD3MGP5W34M/3FU99GE) - value is 0 or 1 (default - means to force the display of the 'history.back' arrow)
# shortmenu
ConditionalSet shortmenu cgi(shortmenu) {} ;# added by GJFB in 2024-01-02
if [string equal {Resume} $referencetype] {
set title "[FormatAuthorList $fullname] - Resume"
}
set encodingName [Execute $documentServerAddress [list GetEncodingName]]
# puts $documentServerAddress
# puts $encodingName
set convertToUTF8 [string equal {utf-8} $encodingName] ;# solves the accent problem - same code is used in xxDocContent.html
# puts $convertToUTF8
if $convertToUTF8 {
# set targetfile [encoding convertto utf-8 $targetfile] ;# Fragmentação -> Fragmentação - commented by GJFB in 2018-12-26 - not needed
set title [encoding convertfrom utf-8 $title] ;# Fragmentação -> Fragmentação
}
# documentServerAddress2
regsub { +} $documentServerAddress {+} documentServerAddress2
if 0 {
# if [regsub {^[^/]+/(col/[^/]+/[^/]+/[^/]+/[^/]+/doc/[^?]*)} $link "$homePath/\\1" filePath] #
if [regsub {^http://[^/]+/(col/[^/]+/[^/]+/[^/]+/[^/]+/doc/[^?]*)} $url "$homePath/\\1" filePath] {
# filePath is used instead of the target file path because they might not be coded in the same way
set convertToUTF8 [expr [string equal {utf-8} $encodingName] && ![file exists $filePath]] ;# 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)
}
}
## puts $site$env(REQUEST_URI)
## regsub {rep/} $site$env(REQUEST_URI) {} bodyLink
# set bodyLink $link
if 0 {
# commented by GJFB in 2014-12-30 - conversion is now made in CreateAbsolutePath - encodingsystem is obsolete
set convertedURL [ConvertURLToHexadecimal $url $convertToUTF8] ;# solves the accent problem - communication from banon-pc3 to plutao
} else {
set convertedURL $url ;# url is already converted in CreateAbsolutePath
}
regsub {http://} $convertedURL {} bodyLink
# puts
# puts $bodyLink
set waitForCompletionFlag 0
if [string equal {Tcl Page} $contenttype] {
# source $homePath/col/$currentRep/doc/@schedule.tcl ;# set timePeriod
Source http://$site/col/$currentRep/doc/@schedule.tcl timePeriod ;# set timePeriod
if {[info exists timePeriod] && $timePeriod} {
set waitForCompletionFlag 1
}
}
# pairList
if $oldCode {
# commented by GJFB in 2017-03-19
lappend pairList metadatarepository=$metadataRep
lappend pairList username=$username
} else {
# added by GJFB in 2017-03-19
# Create automatic short title
# added by GJFB in 2018-01-09
if [string equal {} $shorttitle] {
regsub -all {"} $title {} title2 ;# added by GJFB in 2018-02-13 to avoid error like 'list element in quotes followed by "," instead of space' when running lrange
set shorttitle [lrange $title2 0 2]
if {[llength $title2] > 3} {
set shorttitle $shorttitle...
}
}
# Create automatic short title - end
foreach name $fieldNameListAll {
set value [set $name]
regsub -all {=} $value {%3D} value ;# added by GJFB in 2021-06-13 - to solve title containing string like T&D = x, otherwise the query string in srcHeadder cannot be interpreted correctly - leads to am erfror message like: can't read "cgi(currentRep)": no such variable
ConvertStringWithAccent value ;# added by GJFB in 2023-02-14 because the presence of '#' breaks the query string and produces the error 'can't read "cgi(currentrep)": no such variable' - ex: Simpósio must be converted into Simpósio
lappend pairList $name=$value
}
regsub -all {&} $pairList {%26} pairList ;# added by GJFB in 2021-06-13 - to solve title containing string like T&D, otherwise the query string in srcHeadder cannot be interpreted correctly - leads to am erfror message like: can't read "cgi(currentRep)": no such variable
# puts $pairList
}
if $waitForCompletionFlag {
if {[info tclversion] > 8.4} {set progressKey [clock microseconds]} else {set progressKey [clock seconds]}
# puts $bodyLink
if [regsub {\?} $bodyLink ?clientserveraddresswithip=$clientServerAddressWithIP\\&progresskey=$progressKey\\& refreshBodyLink] {
set refreshURL http://$refreshBodyLink
} else {
set refreshURL http://$bodyLink?clientserveraddresswithip=$clientServerAddressWithIP&progresskey=$progressKey
}
set fileContent "
Waiting for completion
"
file mkdir $homePath/col/$URLibServiceRepository/doc/progressDir
Store fileContent $homePath/col/$URLibServiceRepository/doc/progressDir/$progressKey.html
set bodyWaitingForCompletionURL $localSite/col/$URLibServiceRepository/doc/progressDir/$progressKey.html
# header frame with progresskey
## dropped $ in converttoutf8=$convertToUTF8 by GJFB in 2018-12-26 - this attribute is no more needed
# added $ by GJFB in 2022-02-03
set srcHeadder [ConvertURLToHexadecimal http://$localSite/rep/Header?selectedlanguagefrommirror=$selectedLanguageFromMirror&mirror=$mirror&[join $pairList &]&documentserveraddress=$documentServerAddress2&converttoutf8=$convertToUTF8&languagerep1=$languageRep1&languagerep2=$languageRep2&submissionformrep=$submissionFormRep&searchsite=$searchSite&searchmirror=$searchMirror¤trep=$currentRep&file=$file&state=$state&waitforcompletionflag=$waitForCompletionFlag&agencystructureflag=$agencyStructureFlag&progresskey=$progressKey&bodylink=$bodyLink]
set srcBody $bodyWaitingForCompletionURL
} else {
# header frame without progresskey
## dropped $ in converttoutf8=$convertToUTF8 by GJFB in 2018-12-26 - this attribute is no more needed
# added $ by GJFB in 2022-02-03
set srcHeadder [ConvertURLToHexadecimal http://$localSite/rep/Header?selectedlanguagefrommirror=$selectedLanguageFromMirror&mirror=$mirror&[join $pairList &]&documentserveraddress=$documentServerAddress2&converttoutf8=$convertToUTF8&languagerep1=$languageRep1&languagerep2=$languageRep2&submissionformrep=$submissionFormRep&searchsite=$searchSite&searchmirror=$searchMirror¤trep=$currentRep&file=$file&state=$state&waitforcompletionflag=$waitForCompletionFlag&agencystructureflag=$agencyStructureFlag&bodylink=$bodyLink]
# puts $bodyLink
set srcBody $bodyLink
}
# puts $srcBody
# if ![regexp {:} $pathInfo] # ;# added by GJFB in 2021-11-28 otherwise metadata of restricted access information item are not displayed - commented by GJFB in 2022-09-07
if {![regexp {:} $pathInfo] && [string equal {Data} $urlPropertyArray(contenttype)]} { ;# added by GJFB in 2021-11-28 otherwise metadata of restricted access information item are not displayed - added by GJFB in 2022-09-07 to bypass the warning messages when the ibi is the metadata repository of restricted access item
# not metadata
set noAccessRestrictionFlag [ComputeAccessRestrictionFlag $readpermission $env(REMOTE_ADDR)]
regsub -all {"} $title {%22} title ;# added by GJFB in 2023-04-13 otherwise, when the title contains quotation marks ("), the src attribute value of the body frame for Warning1 gets truncated, resulting in the error: can't read "cgi(srcbody)": no such element in array (usefull for example with id 8JMKD3MGP8W/355229L)
regsub -all {=} $srcBody {%3D} srcBody1 ;# added by GJFB in 2022-07-12 otherwise the Warning1 CONTINUE button query string gets truncated like that: ?requiredmirror=
regsub -all {&} $srcBody1 {%26} srcBody1 ;# added by GJFB in 2022-07-12
if [regexp {allow} $readpermission] {
if !$noAccessRestrictionFlag {
# access restriction
if [ReturnRestrictedAccessWarning $mirrorrepository $documentServerAddress $site] {
if [string equal {} $readergroup] {
# 2. readp allow and readp deny and not readerg * (search expression)
# Warning2
# set srcBody $localSite/rep/Warning2?title=$title&srcbody=$srcBody1 ;# commented by GJFB in 2023-12-16
set srcBody $localSite/rep/Warning2?title=$title&srcbody=$srcBody1&ibiurl.backgroundlanguage=$selectedLanguageFromMirror ;# added by GJFB in 2023-12-16 to ensure the Warning display in the same language as of the upper menu bar
} else {
# 3. readp allow and readp deny and readerg * (search expression)
# Warning1
# set srcBody $localSite/rep/Warning1?title=$title&srcbody=$srcBody1 ;# commented by GJFB in 2023-12-16
set srcBody $localSite/rep/Warning1?title=$title&srcbody=$srcBody1&ibiurl.backgroundlanguage=$selectedLanguageFromMirror ;# added by GJFB in 2023-12-16 to ensure the Warning display in the same language as of the upper menu bar
}
}
}
} else {
# 4. not readp allow and readp deny and readerg * (search expression)
if {[regexp {deny} $readpermission] && ![string equal {} $readergroup]} {
if [ReturnRestrictedAccessWarning $mirrorrepository $documentServerAddress $site] {
# Warning1
# set srcBody $localSite/rep/Warning1?title=$title&srcbody=$srcBody1 ;# commented by GJFB in 2023-12-16
set srcBody $localSite/rep/Warning1?title=$title&srcbody=$srcBody1&ibiurl.backgroundlanguage=$selectedLanguageFromMirror ;# added by GJFB in 2023-12-16 to ensure the Warning display in the same language as of the upper menu bar
}
}
}
}
# puts $srcBody
set englishMirrorRepository $env(ENGLISH_MIRROR_REP)
GetConversionTable $englishMirrorRepository en
global field::conversionTable ;# used in CreateMetadataTags
set errorLogPath $homePath/@errorLog
set tagType DC
set identifierType IBI
set dcType SEO
foreach {name value} [CreateMetadataTags $serverAddress $metadatarepository-0 $tagType $identifierType $errorLogPath $dcType] {
# identifier
# lappend outputList "\t
lappend outputList "" ;# added by GFB in 2023-02-22 for Search engine optimization (SEO)
}
set tagType HP
set identifierType IBI
foreach {name value} [CreateMetadataTags $serverAddress $metadatarepository-0 $tagType $identifierType $errorLogPath] {
# identifier
# lappend outputList "\t
lappend outputList "" ;# added by GFB in 2023-02-22 for Search engine optimization (SEO)
}
set output "
URLib - $title[expr [string equal {} $identifier]?{}:{ | $identifier}]
[join $outputList \n\t\t\t\t\t\t]
Your browser cannot display frames.
"
if 0 {
AcknowledgeArchive $urlPropertyList2 ;# Count one click
} else {
package require http
# servicesubject=acknowledgment
# communication scheme step 5
set clientIPAddress [GetClientIP]
lappend urlPropertyList3 clientinformation.ipaddress $clientIPAddress
lappend urlPropertyList3 contenttype $urlPropertyArray(contenttype)
if [info exists urlPropertyArray(ibi)] {lappend urlPropertyList3 ibi $urlPropertyArray(ibi)} ;# urlPropertyArray(ibi) always exists with the URLib platform but may not exist with others, for example when the URL points to metadata
lappend urlPropertyList3 servicesubject acknowledgment
lappend urlPropertyList3 state $urlPropertyArray(state)
# if [info exists urlPropertyArray(url)] {lappend urlPropertyList3 url $urlPropertyArray(url)}
lappend urlPropertyList3 url $urlPropertyArray(url)
lappend urlPropertyList3 url.persistent http://$localSite$env(REQUEST_URI) ;# add persistent URL
# if [info exists urlPropertyArray(urlkey)] {lappend urlPropertyList3 urlkey $urlPropertyArray(urlkey)}
lappend urlPropertyList3 urlkey $urlPropertyArray(urlkey)
ConditionalSet citingItem cgi(ibiurl.clientinformation.citingitem) {} ;# added by GJFB in 2024-01-04
lappend urlPropertyList3 clientinformation.citingitem $citingItem ;# added by GJFB in 2024-01-04
set queryString [ConvertListForArratyToQueryString $urlPropertyList3]
set documentArchiveAddress $urlPropertyArray(archiveaddress)
set index [lindex $urlPropertyArray(ibi.archiveservice) end]
# puts [ConvertURLToHexadecimal http://$documentArchiveAddress/$index?$queryString 1]
## J8LNKB5R7W/3FTRH3S == Archive service for IBI resolution
# if [catch {http::geturl [ConvertURLToHexadecimal http://$documentArchiveAddress/J8LNKB5R7W/3FTRH3S?$queryString 1]} token] #
if [catch {http::geturl [ConvertURLToHexadecimal http://$documentArchiveAddress/$index?$queryString 1] -timeout 2000} token] {
} else {
# geturl returned
if [string equal {404} [::http::ncode $token]] {
# not found
# puts {not found}
} else {
# puts OK
# puts --[string trimright [http::data $token]]--
}
http::cleanup $token
}
}
if 1 {
# added by GJFB in 2023-02-26 to solve a Google indexing requirement
# see: https://scholar.google.com/intl/en/scholar/inclusion.html#indexing
# puts ../$col/$repository/doc/[file dirname $targetfile]/thisInformationItemHomePage.html
if {[string equal -nocase {.pdf} [file extension $targetfile]] && ![regexp {/customizeerror.cgi/409} $srcBody] && ![string equal {External Contribution} $contenttype]} {
# Store output ../$col/$repository/doc/[file dirname $targetfile]/thisInformationItemHomePage.html ;# commented by GJFB in 2023-03-02
Store output ../$col/$repository/doc/[file dirname $targetfile]/thisInformationItemHomePage.html auto 0 w 0 iso8859-1 ;# added by GJFB in 2023-03-02 - solves the accent/channel problem in title and meta tags - Aplicação -> Aplicação (solves accent problem in: http://mtc-m21b.sid.inpe.br/col/sid.inpe.br/mtc-m21b/2016/12.19.13.06/doc/thisInformationItemHomePage.html)
if 0 {
# commented by GJFB in 2023-03-02
puts $output
} else {
# added by GJFB in 2023-03-02
puts "
Redirection to thisInformationItemHomePage.html
"
}
} else {
file delete ../$col/$repository/doc/[file dirname $targetfile]/thisInformationItemHomePage.html
puts $output
}
return
}
# end default
}
} ;# end switch
puts $output
} m] {
if !$redirectFlag {
# commented by GJFB in 2021-05-23
puts {Content-Type: text/html}
# puts {Content-Type: text/plain}
puts {}
}
if [regexp {.*} $m] {
# HTML code
# puts {HTML code}
puts {Content-Type: text/html} ;# added by GJFB in 2023-03-20 - required to display the 'identifier warning' message (see output of DisplayWarningMessage)
puts {}
puts $m
if 0 {global errorInfo; puts $errorInfo}
} else {
# not an HTML code
puts
puts $m
if 0 {global errorInfo; puts $errorInfo}
# >>> to see the puts output you might go to the bottom of the source code page of the upper menu
puts
}
}
}
#
#
# Resume
#
#
#
#
#
#
#
#
# Get - end
# ----------------------------------------------------------------------
# CreateAdditionalRowList
# used in CreatePasswordField only
proc CreateAdditionalRowList {} {
global languageRep2
global "${languageRep2}::password field - enter the password for the login \$userName"
set additionalRowList {}
lappend additionalRowList "
"
set variableName "password field - enter the password for the login \$userName"
lappend additionalRowList ""
lappend additionalRowList "
"
lappend additionalRowList ""
set additionalRowList [join $additionalRowList \n]
set additionalRowList2 {}
foreach line [split $additionalRowList \n] {
regsub -all {"} $line {\\"} line
lappend additionalRowList2 \"$line\"
}
set additionalRowList [join $additionalRowList2 ,\n]
return $additionalRowList
}
# CreateAdditionalRowList - end
# ----------------------------------------------------------------------
# CreatePasswordField
proc CreatePasswordField {userName} {
global cgi
return "
"
}
# CreatePasswordField - end
# ----------------------------------------------------------------------
# ReturnRestrictedAccessWarning
# returns, if any, the value of the restrictedAccessWarning variable set in the appropriate displayControl.tcl file
proc ReturnRestrictedAccessWarning {mirrorRepository documentServerAddress site} {
global homePath
global env
if [string equal {} $mirrorRepository] {
set documentDefaultBibliographicMirror [Execute $documentServerAddress [list GetDefaultBibliographicMirror]]
} else {
set documentDefaultBibliographicMirror $mirrorRepository
}
set documentMirrorHomePageRep [Execute $documentServerAddress [list GetCitedRepositoryList $documentDefaultBibliographicMirror]]
source $homePath/col/$env(MIRROR_HOME_PAGE_REPOSITORY)/doc/displayControl.tcl ;# added by GJFB in 2022-10-10 required to set the list referenceTypeList that migth be used in some sources below, for example when sourcing col/iconet.com.br/banon/2003/05.31.10.26/doc/displayControl.tcl
Source http://$site/col/$documentMirrorHomePageRep/doc/displayControl.tcl restrictedAccessWarning 1 ;# set restrictedAccessWarning
if [info exists restrictedAccessWarning] {
return $restrictedAccessWarning
} else {
set parentRepList [Execute $documentServerAddress [list GetCitedRepositoryList $documentMirrorHomePageRep]]
foreach rep $parentRepList {
if [Execute $documentServerAddress [list TestContentType $rep {Submission Form}]] {
# a Submission Form
Source http://$site/col/$rep/doc/displayControl.tcl restrictedAccessWarning 1 ;# set restrictedAccessWarning
if [info exists restrictedAccessWarning] {
return $restrictedAccessWarning
}
break
}
}
}
return 0 ;# default
}
# ReturnRestrictedAccessWarning - end
# ----------------------------------------------------------------------
# FindSiteList
# used just in Get
# site is document site
proc FindSiteList {documentMirrorRep site documentServerAddress} {
global homePath
if [file isdirectory $homePath/col/$documentMirrorRep] {
# document site is the current site
set siteList {} ;# MultipleSubmit will use currentRep
} else {
package require http ;# see online manual
set token [http::geturl http://$site/col/$documentMirrorRep/doc/@siteList.txt]
if ![regexp {200 OK} [http::code $token]] {
# file not found - @siteList.txt may not exist
set fileContent {}
} else {
# documentMirrorRep is part of the document site
set fileContent [http::data $token]
}
http::cleanup $token
foreach {siteList} [FormatSiteList $fileContent $documentServerAddress] {break}
}
}
# FindSiteList - end
# ----------------------------------------------------------------------
![](\"http://$localSite/col/$defaultMirrorHomePageRepository/doc/images/ajax-loader.gif\")