# Copyright for the Uniform Repository Service (c) 1995 - 2019,
# by Gerald Banon. All rights reserved.
# Version 2.1
# get.tcl
# Examples:
if 0 {
http://banon-pc3/rep/iconet.com.br/banon/2001/02.10.22.55
http://banon-pc3/rep/LK47B6W/E6H5HH
http://banon-pc3/rep/dpi.inpe.br/banon/1998/08.02.08.56
http://banon-pc3/rep/dpi.inpe.br/banon/1998/08.02.08.56/post
http://banon-pc3/rep/iconet.com.br/banon/2001/02.10.22.55+
http://banon-pc3/rep/LK47B6W/E6H5HH+
http://vaio:1905/rep/J8LNKB5R7W/3NGUDHH
http://vaio:1905/rep/J8LNKB5R7W/3NGUDHH:
http://gjfb.home:1905/rep/8JMKD3MGP3W34P/3MPQ9AE
http://urlib.net/rep/8JMKD3MGPAW34P/3NERTH2
http://urlib.net/rep/J8LNKB5R7W/3CAK5T2
http://urlib.net/rep/8JMKD3MGPAW/3MGQ5S5
http://urlib.net/rep/J8LNKB5R7W/3CP2248
}
# ----------------------------------------------------------------------
# Get
proc Get {} {
if [catch {
set currentProcedureName Get
global env
global cgi ;# used by FindLanguage, ResolveIBI, CreatePasswordField and CheckUsernamePasswordForm
global localSite ; # used in CreateResponseList
global homePath ;# used in CreateListOfurlPropertiesFromAgencies and FindLanguage
global URLibServiceRepository ;# used in ReturnFullServerNameIP
global loCoInRep ;# used in CreateListOfurlPropertiesFromAgencies and FormatSiteList called by FindURLPropertyList called by ReturnURLPropertyList called by ReturnURLPropertyList2 called by ResolveIBI
global loBiMiRep ;# used in FindURLPropertyList
global serverAddress ;# used by SetFieldValue
# global documentServerAddress ;# used in UpdateReadPermissionFromSecondaryDate
global languageRep2 ;# used in CreateAdditionalRowList only
global mirrorHomePageRep ;# set in FindLanguage
global queueLengthFlag ;# used in MultipleSubmit (called in MultipleExecute2 called in CreateOutput)
global printFlag ;# used in ReturnURLPropertyList only
global multipleLineReferFieldNamePattern ;# used by GetReferField (called by CreateVersionStamp called by ChangeFieldValue)
global urlibServerAddress ;# used in BuildReturnPathArray only
global queryString ;# used in BuildReturnPathArray only
global selectedLanguageFromMirror languageRep1 languageRep2 ;# used in CreateResponseList only
global tcl_platform
global serverAdministratorAddress ;# used in FindURLPropertyList
set printFlag 0
# set printFlag 1
puts {Content-Type: text/html}
# puts {Content-Type: text/plain}
puts {}
# puts [encoding system]
# defaultMirrorHomePageRepository
set defaultMirrorHomePageRepository dpi.inpe.br/banon/2000/01.23.20.24
# col
set col ../../../../..
set URLibServiceRepository $env(URLIB_SERVICE_REP)
# set urlibServerAddressWithIP $env(URLIB_SERVER_ADDR) ;# ip and port of www.urlib.net
set standaloneModeFlag $env(STANDALONE_MODE_FLAG)
source ../$col/$URLibServiceRepository/doc/utilities1.tcl
source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl
# set queueLengthFlag 1 ;# could be anything - added by GJFB in 2013-04-17 in order to detect not writable site (site that doesn't reply)
# loCoInRep
set loCoInRep $env(LOCOINREP)
# loCoInRep
set loBiMiRep $env(LOBIMIREP)
# homePath (used in FindLanguage)
set homePath $env(DOCUMENT_ROOT)
# currentProcedureFileName (for reverse engineering only)
set currentProcedureFileName $homePath/col/$URLibServiceRepository/doc/cgi/get.tcl
# puts $env(QUERY_STRING)
# queryString
ConditionalSet queryString env(QUERY_STRING) {}
set queryString [EscapeUntrustedData $queryString]
if ![string equal {} $queryString] {
# bodylink is used in Submit (see cgi/submit.tcl)
if [regexp {(bodylink)=(.*)$} $queryString m name value] {
set cgi($name) [DecodeURL $value]
}
# puts $cgi(bodylink)
regsub {&?bodylink=.*$} $queryString {} queryString2
# ? is alias for verb=GetMetadata
regsub {^\?} $queryString2 {} queryString2
foreach {name value} [split $queryString2 &=] {
set cgi([DecodeURL $name]) [DecodeURL $value]
}
}
puts [array get cgi]
# localSite
set localSite $env(SERVER_NAME):$env(SERVER_PORT) ;# used in the document not found warning and in syntax error
# serverAddress
set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# serverAddressWithIP
set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
# clientServerAddressWithIP
regsub -all { } $serverAddressWithIP {+} clientServerAddressWithIP
# urlibServerAddress
set urlibServerAddress $env(URLIB_SERVER_ADDR) ;# www.urlib.net and port
# serverAdministratorAddress
set serverAdministratorAddress $env(SERVER_ADMIN)
if 0 {
# commented by GJFB in 2014-04-23 - choice is conflicting when displaying metadata
# choice - useful for adding searchSiteName when choice is not brief
ConditionalSet choice cgi(choice) {}
}
# > mirror
# requiredmirror=sid.inpe.br/mtc-m21b/2013/09.26.14.25.22
ConditionalSet mirror cgi(requiredmirror) $loBiMiRep ;# used in this procedure only
# > searchSite - useful for searching in header
# searchsite=bibdigital.sid.inpe.br:80
ConditionalSet searchSite cgi(searchsite) $localSite ;# without this line and localsite attribute, www.urlib.net gets a 100% cpu - searchSite value might be changed below for Archival Unit
# > searchMirror - useful for searching in header
# searchmirror=sid.inpe.br/bibdigital@80/2006/04.07.15.50.13
ConditionalSet searchMirror cgi(searchmirror) $mirror ;# searchMirror value might be changed below for Archival Unit and Misc
regsub {\..*(:.*)} $searchSite {\1} searchSiteName ;# bibdigital.sid.inpe.br used in mirror/xxCover.tcl
if [info exists cgi(submissionformrep)] {
set selectedLanguageFromMirror $cgi(selectedlanguagefrommirror)
set languageRep1 $cgi(languagerep1) ;# used in $Header
set languageRep2 $cgi(languagerep2)
set submissionFormRep $cgi(submissionformrep)
} else {
# Find the language and the language repository
# use the same languages as the ones used for the local bibliographic mirror
foreach {selectedLanguageFromMirror languageRep1 languageRep2 firstLanguageRep \
submissionFormRep submissionFormLanguage submissionFormLanguageRep} \
[FindLanguage $mirror] {break}
# puts $selectedLanguageFromMirror
# Find the language and the language repository - end
}
# filePath (for reverse engineering only)
if [file exists $homePath/col/$languageRep1/doc/mirror/${selectedLanguageFromMirror}Cover.tcl] {
set filePath $languageRep1/doc/mirror/${selectedLanguageFromMirror}Cover.tcl
} else {
set filePath $languageRep2/doc/mirror/${selectedLanguageFromMirror}Cover.tcl
}
if 0 {
# doesn't work when opening sid.inpe.br/mtc-m15@80/2006/12.06.11.48 (located at mtc-m15)
# see new code below within the switch
# set convertToUTF8 [expr [regexp {Apache/2} $env(SERVER_SOFTWARE)] || [string equal {utf-8} $env(ENCODING_SYSTEM)]] ;# solves the accent problem - same code is used in xxDocContent.html
set convertToUTF8 1 ;# solves the accent problem
}
# pathInfo
if [info exists env(PATH_INFO)] {
set pathInfo $env(PATH_INFO)
} else {
set pathInfo /
}
set pathInfo [string trim $pathInfo] ;# added by GJFB in 2011-05-03 - some paths may contain trailing blanks that are interpreted further as /
# splitedPathInfo
set splitedPathInfo [file split $pathInfo]
# frameName
set frameName [lindex $splitedPathInfo 1]
set oldCode 1 ;# still work unless the access to the URLibService of the Archive which have the identificated item is not fully permitted
# ex: http://gjfb.home:1905/rep/8JMKD3MGP3W34P/3MPQ9AE doesn't work because m21b has the port 804 is not fullly open
set oldCode 0 ;# new code - added by GJFB in 2017-03-19 - with this code http://gjfb.home:1905/rep/8JMKD3MGP3W34P/3MPQ9AE works because there is no need for gjfb.home:1905 to access directly m21b - this is done indirectly via urlib.net
if $oldCode {
# commented by GJFB in 2017-03-19
} else {
# added by GJFB in 2017-03-19
set fieldNameList1 {title targetfile referencetype fullname contenttype username}
set fieldNameList2 {metadatarepository identifier referencetype size targetfile language readpermission contenttype copyright rightsholder doi nextedition previousedition issn nexthigherunit mirrorrepository parameterlist}
set fieldNameList3 {repository metadatarepository metadatalastupdate nexthigherunit shorttitle}
set fieldNameList4 {nexthigherunit shorttitle}
set fieldNameListAll [lsort -unique [concat $fieldNameList1 $fieldNameList2 $fieldNameList3]]
}
# puts --$frameName--
if ![regexp {\.} $frameName] {
# not a domain name
# Return, Header and AdvancedUserHeader
# dropped $ in VALUE="$cgi(converttoutf8) by GJFB in 2018-12-26 - this attribute is no more needed
set hiddenInputs {
}
if $oldCode {
# commented by GJFB in 2017-03-19
append hiddenInputs {\n}
append hiddenInputs {\n}
} else {
# added by GJFB in 2017-03-19
# username must not be part of hiddenInputs, the hidden input username aready exists and cannot be duplicated
foreach item $fieldNameListAll {
append hiddenInputs "\n"
}
}
}
# set termsOfUse {}
switch -regexp -- $frameName {
{Header|AdvancedUserHeader} {
set headerType $frameName
# puts "1 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
# puts [array get cgi]
# puts $env(PATH_INFO)
# => /iconet.com.br/banon/2001/02.10.22.55/post
# puts ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}SearchResult.tcl
ConditionalSet queryValue cgi(query) {}
ConditionalSet userName cgi(username) {}
ConditionalSet codedPassword1 cgi(codedpassword1) {}
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}SearchResult.tcl ;# access the files that comprise the document
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}Cover.tcl ;# Header, wrong password, ...
global "${languageRep2}::Header" ;# uses languageRep1
global "${languageRep2}::unknown username"
global "${languageRep2}::empty password"
global "${languageRep2}::wrong password"
global "${languageRep2}::the original author"
global "translationTable" ;# set in mirror/xxSearchResult.tcl and in mirror/xxCover.tcl
global "Update"
# currentRep (the repository of the current ibi)
set currentRep $cgi(currentrep)
# textLanguage
ConditionalSet textLanguage cgi(textlanguage) {}
# puts --$textLanguage--
# documentServerAddress
set documentServerAddress $cgi(documentserveraddress)
# puts --$documentServerAddress--
# waitForCompletionFlag
set waitForCompletionFlag $cgi(waitforcompletionflag)
# agencyStructureFlag
set agencyStructureFlag $cgi(agencystructureflag)
# progressKey
ConditionalSet progressKey cgi(progresskey) {}
# SET FIELD VALUES
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 {identifier referencetype size username targetfile language readpermission contenttype copyright rightsholder doi nextedition previousedition issn nexthigherunit}
SetFieldValue $documentServerAddress $cgi(metadatarepository)-0 {identifier referencetype size targetfile language readpermission contenttype copyright rightsholder doi nextedition previousedition issn nexthigherunit mirrorrepository parameterlist}
} else {
# added by GJFB in 2017-03-19
# set fieldNameList2 {metadatarepository identifier referencetype size username targetfile language readpermission contenttype copyright rightsholder doi nextedition previousedition issn nexthigherunit mirrorrepository parameterlist}
set pairList {}
foreach item2 $fieldNameList2 {
set $item2 $cgi($item2)
}
}
# puts --$identifier--
if [string equal {} $cgi(file)] {
set currentTargetFile $targetfile ;# use the default target file
} else {
set currentTargetFile $cgi(file)
}
if 0 {
# old code
# commented by GJFB in 2013-09-21
# the target file may have changed (when cgi(turnattachedfiletargetfile) has been set to yes)
regsub {([^/]+/[^/]+/\d{4,}/[^/]+/doc/).*\?} $cgi(bodylink) \\1$targetfile? bodyLink
# puts $bodyLink
# bodyLink2
regsub -all { } $bodyLink {} bodyLink2 ;# Archival Unit -> ArchivalUnit - added by GJFB in 2013-09-11 - when cgi(bodylink) contains a blank (e.g., Archival Unit) it will be traited as a check box type entry value by MakeCGIArray (see JoinCGIEntries) in Submit (see cgi/submit.tcl)
# => http://banon-pc3/displaydoccontent.cgi/urlib.net/www/2013/06.21.00.03?displaytype=ArchivalUnit&metadatarepository=urlib.net/www/2013/06.21.00.03.30&languagebutton=pt-BR
set bodyLink2 [join [ConvertURLToHexadecimal $bodyLink2 $cgi(converttoutf8)]]
# puts $bodyLink2
# bodyLink3
if [regexp {Archival Unit|Resume} $referencetype] {
set bodyLink3 $bodyLink2&updatebodyflag=1 ;# used in DisplayDocContent when returning to the document after a Run
} else {
set bodyLink3 $bodyLink2
}
} else {
# added by GJFB in 2013-09-21 - the code above can now be simplified since bodyLink is just $site/$currentRep (or $site/$currentRep/$file ...)
set bodyLink $cgi(bodylink)
# regsub -all { } $cgi(bodylink) {+} bodyLink
# set bodyLink2 $cgi(bodylink)
# set bodyLink2 [join [ConvertURLToHexadecimal $cgi(bodylink) $cgi(converttoutf8)]]
# set bodyLink2 [ConvertURLToHexadecimal $cgi(bodylink) $cgi(converttoutf8)] ;# added by GJFB - bodyLink2 must be coded otherwise the refresh button doesn´t work when the URL contains accents - commented by GJFB in 2018-12-26 otherwise the button Hide, Refresh and Run in the menu bar of http://md-m09.sid.inpe.br/rep/sid.inpe.br/md-m09/2013/07.04.14.29 don't work because of an accent problem
set bodyLink2 [ConvertURLToHexadecimal $cgi(bodylink)] ;# added by GJFB in 2018-12-26 - bodyLink2 must not be converted to utf-8
# bodyLink3
if [regexp {Archival Unit|Resume} $referencetype] {
if [regexp {\?} $bodyLink2] {
set bodyLink3 $bodyLink2&updatebodyflag=1
} else {
set bodyLink3 $bodyLink2?updatebodyflag=1
}
} else {
set bodyLink3 $bodyLink2
}
}
# targetFileExtension
set targetFileExtension [file extension $targetfile]
# inputTitle
set inputTitle {see the return path up to the root}
# site (document site)
set site [ReturnHTTPHost $documentServerAddress]
# documentServerIP
# puts "1.1 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
# set documentServerIP [lindex [ReturnFullServerNameIP [lindex $documentServerAddress 0]] end] ;# used in mirror/xxCover.tcl and in this procedure - commented by GJFB in 2019-04-02
set pingFlag 0 ;# added by GJFB in 2019-04-02 to disable ping when this script (Get) is run under unix - when this script (Get) is run by urlib.net and the document server address is at 150.163, this is necessary because there exists a firewall in between at INPE
set documentServerIP [lindex [ReturnFullServerNameIP [lindex $documentServerAddress 0] $pingFlag] end] ;# used in mirror/xxCover.tcl and in this procedure - added by GJFB in 2019-04-02
# puts --$documentServerIP--
# puts "1.2 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
# resolverSite
if $standaloneModeFlag {
set resolverSite $localSite
} else {
set resolverSite [ReturnHTTPHost $urlibServerAddress]
}
# documentMirrorRep
# puts --$mirrorrepository--
# set mirrorMetadataRep [FindMetadataRepositories [list repository, $mirrorrepository] 0 [list $documentServerAddress]] ;# mirrorrepository visibility must be shown
if [string equal {} $mirrorrepository] {
set documentMirrorRep [Execute $documentServerAddress [list ReturnLoBiMiRep]]
} else {
set mirrorMetadataRep [Execute $documentServerAddress [list FindMetadataRep $mirrorrepository]]
# puts --$mirrorMetadataRep--
if [string equal {} $mirrorMetadataRep] {
# mirrorrepository doesn´t exist in the document collection
set documentMirrorRep [Execute $documentServerAddress [list ReturnLoBiMiRep]]
} else {
# mirrorrepository exists in the document collection
set documentMirrorRep $mirrorrepository
}
}
if [string equal {AdvancedUserHeader} $frameName] {
# AdvancedUserHeader
# Check password
if [string equal {Tcl Page} $contenttype] {
set jqueryCode "
\$(document).ready(function() {
\$.PeriodicalUpdater('http://$site/col/$currentRep/doc/@progress.txt', {
maxTimeout: 4000
},
function(data) {
\$('#progress').text(data);
});
})
"
} elseif {[string equal {Archival Unit} $referencetype]} {
set jqueryCode "
\$(document).ready(function() {
\$.PeriodicalUpdater('http://$site/getprogress?repository=$currentRep', {
maxTimeout: 4000
},
function(data) {
\$('#progress').text(data);
});
})
"
} else {
set jqueryCode {}
}
set targetFileType [string trimleft $targetFileExtension .]
# puts --$documentServerAddress--
if [string equal {} $documentServerIP] {
# standalone or LAN mode or nslookup fails or ping fails in ReturnFullServerNameIP
# use domain name instead
set documentServerIP [lindex $documentServerAddress 0] ;# no IP, use the host name
}
set documentServerPort [lindex $documentServerAddress end]
set serverAddressWithIP [list $documentServerIP $documentServerPort] ;# used in CheckUsernamePasswordForm
# puts --$serverAddressWithIP--
set numberOfRecords $cgi(numberofrecords)
set digitalStorageIndicator $cgi(digitalstorageindicator)
set message [CheckUsernamePasswordForm]
if [string equal {} $message] {
set termsOfUse {}
set simplifiedRightsholder {}
} else {
set termsOfUse $cgi(termsofuse)
set simplifiedRightsholder $cgi(simplifiedrightsholder)
set frameName {Header}
}
# display check box for the File Name field
source ../$col/$languageRep2/doc/mirror/${selectedLanguageFromMirror}Submit.tcl ;# {turn the attached file, the target file}
global "${languageRep2}::turn the attached file, the target file"
if ![string equal {Electronic Source} $referencetype] {
# set chekBoxCode " "
set chekBoxCode "
|
"
} else {
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
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)
}
}
}
# #
if [regexp {^(Archival Unit|Misc)$} $referencetype] {
# 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
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
}
ConditionalSet searchExpression parameterArray(searchexpression) "nexthigherunit, $identifier"
ConditionalSet choice parameterArray(choice) briefTitleAuthorMisc
ConditionalSet outputFormat parameterArray(outputformat) ref-year-cite
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
set currentRep2 $currentRep ;# preserve currentRep
set currentRep $searchMirror ;# used MultipleSubmit
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 [file isdirectory $homePath/col/$documentMirrorRep] {
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 {
set fileContent [http::data $token]
}
http::cleanup $token
foreach {siteList} [FormatSiteList $fileContent $documentServerAddress] {break}
}
global searchResultList
# puts --$siteList--
set query [list list GetMetadataRepositories {} 0 $searchExpression yes yes 1]
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
# Compute numberOfRecords - end
# puts "4 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
}
# puts $numberOfRecords
}
# 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
# referenceType
regsub -all { } $translationTable($referencetype) {\ } referenceType
# 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$|^Conference Proceedings$|^Audiovisual Material$|^Thesis$|^Report$|^Electronic Source$|^Misc$} $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)
}
}
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
} else {
set missingNextHigherUnitIBIList {}
set color #000000
}
# puts $color
# set output [subst $Header]
# puts --$shorttitle--
# puts "5 - [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]"
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]]
# >>> for testing
# set condition [expr $agencyStructureFlag && [string equal {} $queryString]] ;# for testing
if $condition {
# 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 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
# 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
Execute $documentServerAddress [list RemoveMetadata $metadata2List]
Execute $documentServerAddress [list AddMetadata $metadataList]
Execute $documentServerAddress [list UpdateRepositoryListForPost $repositoryList]
Execute $documentServerAddress [list LeaveQueue] 0 ;# not async
}
# Update nexthigherunit field - end
}
}
}
# Check for deleted next higher unit - end
}
# return
# puts $shorttitle
set missingNextHigherUnitIBIList {}
set i 1
if [catch {BuildReturnPathArray [list {} $nexthigherunit $shorttitle] $agencyStructureFlag}] {
global errorInfo
puts "" ;# to see the error message, see the bottom part of the source code of the menu bar
} else {
# StoreArray returnPathArray $homePath/col/$currentRep/auxdoc/returnPathArray.tcl w list array 1 ;# if $homePath/col/$currentRep/auxdoc is not a directory then StoreArray returns silently with nothing done
file mkdir $homePath/clipboard3/$currentRep/auxdoc ;# added by GJFB in 2018-03-30
StoreArray returnPathArray $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl w list array 1 ;# added by GJFB in 2018-03-30 to allow a remote Archive (like urlib.net) to store returnPathArray.tcl
# missingNextHigherUnitIBIList is computed in BuildReturnPathArray
# when missingNextHigherUnitIBIList is not empty (i.e, there are some missing next higher units) and licuri goes down,
# it is necessary to edit the file @siteList.txt dropping the corresponding tailing 1, otherwise the menu bar is delayed for 12 to 23 s
# puts --$missingNextHigherUnitIBIList--
if [llength $missingNextHigherUnitIBIList] {
# There are missing next higher units
Store missingNextHigherUnitIBIList $homePath/clipboard3/$currentRep/auxdoc/missingNextHigherUnitIBIList.txt ;# added by GJFB in 2018-03-30 to allow a remote Archive (like urlib.net) to store missingNextHigherUnitIBIList.txt
} else {
file delete $homePath/clipboard3/$currentRep/auxdoc/missingNextHigherUnitIBIList.txt ;# added by GJFB in 2018-03-30
}
}
# puts [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]
return
} ;# Header|AdvancedUserHeader - end
{Return} {
# return to root
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)
ConditionalSet progressKey cgi(progresskey) {}
set bodyLink $cgi(bodylink)
# migration 2018-03-30
file delete $homePath/col/$currentRep/auxdoc/returnPathArray.tcl
# migration 2018-03-30 - end
if [file exists $homePath/clipboard3/$currentRep/auxdoc/returnPathArray.tcl] {
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
if [catch {BuildReturnPathArray [list {} $nexthigherunit $shorttitle] $agencyStructureFlag}] {
global errorInfo
puts ""
}
}
# puts --[array get returnPathArray]--
# returnPathArray example:
# 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 83LX3pFwXQZ5Jpy/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}}
if 0 {
# the command regexp ^$returnPathi $returnPathj below returns an error: couldn't compile regular expression pattern: invalid repetition count(s)
# when returnPathi is for example like: {8JMKD3MGPCW/3DT298S INPE 8JMKD3MGP7W/3E6FG2L WETEs 8JMKD3MGP7W/3F4BK9B {4º WETE} {} {}}
set nameList [array names returnPathArray]
set k 1
foreach i $nameList {
set includeFlag 0 ;# not strictly included
foreach j $nameList {
# puts [list $returnPathArray($i) $returnPathArray($j)]
# =>
# {3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}} {3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}}
# {3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}} {3ERPFQRTRW34M/3E7G88S {SBSR 16} 3ERPFQRTRW34M/3EHNQ68 Indice {} {}}
# {3ERPFQRTRW34M/3E7G88S {SBSR 16} 3ERPFQRTRW34M/3EHNQ68 Indice {} {}} {3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}}
# {3ERPFQRTRW34M/3E7G88S {SBSR 16} 3ERPFQRTRW34M/3EHNQ68 Indice {} {}} {3ERPFQRTRW34M/3E7G88S {SBSR 16} 3ERPFQRTRW34M/3EHNQ68 Indice {} {}}
set returnPathi [lrange $returnPathArray($i) 0 end-2]
set returnPathj [lrange $returnPathArray($j) 0 end-2]
if {$i != $j && [regexp ^$returnPathi $returnPathj]} {
# ^ab abc
set includeFlag 1 ;# strictly included
break
}
}
if !$includeFlag {
set returnPathArray2($k) $returnPathArray($i)
incr k
}
}
} else {
array set returnPathArray2 [array get returnPathArray]
}
set nameList [array names returnPathArray2]
set numberOfReturnPaths [llength $nameList]
# puts --$nameList--
foreach i $nameList {
# puts --$returnPathArray2($i)--
set returnPathArray3($i) {}
foreach {ibi shortTitle} $returnPathArray2($i) {
if [string equal {} $ibi] {
lappend returnPathArray3($i) "$shortTitle"
} else {
# lappend returnPathArray3($i) "$shortTitle"
lappend returnPathArray3($i) "$shortTitle" ;# ibiurl.language is alias for languagebutton
}
}
# puts --[array get returnPathArray3]--
if {$numberOfReturnPaths > 1} {
set returnPathArray3($i) "($i/$numberOfReturnPaths) - [join $returnPathArray3($i) { > }]"
} else {
set returnPathArray3($i) [join $returnPathArray3($i) { > }]
}
}
if {$returnPathNumber >= $numberOfReturnPaths} {
set returnAction $cgi(headertype)
set inputValue >
set inputTitle {go to the menu}
} else {
set returnAction Return
set inputValue <
set inputTitle {see the return path up to the root}
}
set output [subst $Return]
}
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 /
}
# puts --$queryString--
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
}
# 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
} else {
# added by GJFB in 2017-03-19
lappend parsedIBIURL parsedibiurl.metadatafieldnamelist $fieldNameListAll ;# added by GJFB in 2017-03-19
}
# Create urlPropertyList2
# set agencyStructureFlag 0 ;# disable agency structure
set agencyStructureFlag 1 ;# enable agency structure
set condition [expr $agencyStructureFlag && ([string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]) && [string equal {} $queryString]]
# >>> for testing
# http://vaio:1905/rep/urlib.net/www/2017/07.08.14.36
# set condition [expr $agencyStructureFlag && [string equal {} $queryString]] ;# 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--
# puts $condition
if $condition {
# agency structure specific code
# www.urlib.net resolver running
# use of the HTTP protocol
set urlPropertyList2 [CreateListOfurlPropertiesFromAgencies $parsedIBIURL $selectedLanguageFromMirror $languageRep1 $languageRep2 $localSite]
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
# RESOLVEIBI
# 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 urlPropertyList2 [ResolveIBI $parsedIBIURL $selectedLanguageFromMirror $displayWarningMessage $currentProcedureName 0 $agencyStructureFlag] ;# added by GJFB in 2017-02-20
# puts [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]
# puts --$urlPropertyList2--
# set xxx 1-$urlPropertyList2
# Store xxx C:/tmp/bbb.txt binary 0 a
}
# Create urlPropertyList2 - end
array set urlPropertyArray $urlPropertyList2
# site
set site $urlPropertyArray(archiveaddress)
# puts $site
# documentServerAddress
set documentServerAddress [GetServerAddressFromHTTPHost $site]
# url
set url $urlPropertyArray(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 used in a hidden code in mirror/xxCover.tcl
} else {
# added by GJFB in 2017-03-19
ConditionalSet metadataFieldList urlPropertyArray(metadatafieldlist) {}
foreach {metadataFieldName metadataFieldValue} $metadataFieldList {
set $metadataFieldName $metadataFieldValue ;# set title, targetfile, referencetype, fullname, ...
}
# 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)
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
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 item $fieldNameListAll {
lappend pairList $item=[set $item]
}
}
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 http://$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
set output "
URLib - $title
Your browser cannot display frames.
"
} else {
# header frame without progresskey
# dropped $ in converttoutf8=$convertToUTF8 by GJFB in 2018-12-26 - this attribute is no more needed
set output "
URLib - $title
Your browser cannot display frames.
"
}
if 0 {
AcknowlegeArchive $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)
set queryString [ConvertListForArratyToQueryString $urlPropertyList3]
set documentServerAddress $urlPropertyArray(archiveaddress)
set index [lindex $urlPropertyArray(ibi.archiveservice) end]
# puts [ConvertURLToHexadecimal http://$documentServerAddress/$index?$queryString 1]
## J8LNKB5R7W/3FTRH3S == Archive service for IBI resolution
# if [catch {http::geturl [ConvertURLToHexadecimal http://$documentServerAddress/J8LNKB5R7W/3FTRH3S?$queryString 1]} token] #
if [catch {http::geturl [ConvertURLToHexadecimal http://$documentServerAddress/$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
}
}
}
}
puts $output
} m] {
if [regexp {.*} $m] {
# HTML code
# puts {HTML code}
puts $m
if 0 {global errorInfo; puts $errorInfo}
} else {
# not an HTML code
puts
puts $m
if 0 {global errorInfo; puts $errorInfo}
puts
}
}
}
#
#
# Resume
#
#
#
#
#
#
#
#
# Get - end
# ----------------------------------------------------------------------
# BuildReturnPathArray
# recurrent procedure
# idNextTitle is a list of the type: {identifier nexthigherunit shorttitle} (nexthigherunit and shorttitle is with respect to identifier)
# returnPathArray entries are lists of the type: {{identifier shorttitle} {identifier shorttitle} ...}
proc BuildReturnPathArray {idNextTitle agencyStructureFlag} {
global serverAddress
global urlibServerAddress
global queryString
upvar i i
upvar returnPathArray returnPathArray
upvar missingNextHigherUnitIBIList missingNextHigherUnitIBIList
# puts [list $idNextTitle $i]
# => {{} {3ERPFQRTRW34M/3E7G88S 3ERPFQRTRW34M/3EHNQ68} {}} 1
# puts --[array get returnPathArray]--
# => ----
foreach {id unitList shortTitle} $idNextTitle {break}
if ![info exists returnPathArray($i)] {set returnPathArray($i) {}}
set returnPathUpToNow $returnPathArray($i)
# puts --$unitList--
foreach unit $unitList {
if [info exists urlPropertyArray] {unset urlPropertyArray}
set returnPathArray($i) [concat [list $id $shortTitle] $returnPathUpToNow]
# puts 1-[list $returnPathArray($i) $i]
# puts $unit
# http://gjfb/J8LNKB5R7W/3D3EHEL?ibiurl.metadatafieldnamelist=identifier+nexthigherunit+shorttitle
# http://gjfb/J8LNKB5R7W/3EHTB7P?ibiurl.metadatafieldnamelist=identifier+nexthigherunit+shorttitle
# http://gjfb.home/J8LNKB5R7W/3EB9F8L?ibiurl.metadatafieldnamelist=identifier+nexthigherunit+shorttitle
# set parsedIBIURL [list parsedibiurl.ibi $unit parsedibiurl.metadatafieldnamelist {identifier nexthigherunit shorttitle}] ;# used in Get - commented by GJFB in 2018-01-09
set parsedIBIURL [list parsedibiurl.ibi $unit parsedibiurl.metadatafieldnamelist {identifier nexthigherunit shorttitle title}] ;# used in Get - added by GJFB in 2018-01-09
set condition [expr $agencyStructureFlag && ([string equal $serverAddress $urlibServerAddress] || [string equal www.$serverAddress $urlibServerAddress]) && [string equal {} $queryString]]
# >>> for testing
# set condition [expr $agencyStructureFlag && [string equal {} $queryString]] ;# for testing
if $condition {
# agency structure specific code
# www.urlib.net resolver running
# use of the HTTP protocol
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
# find the url properties of the ibi within the scope defined in @siteList.txt of the default bibliographic mirror (LoBiMiRep) of the local/current site
# not agency structure specific code
# any Archive running
# any resolvers (www.urlib.net or agency resolvers) running
# agency resolver running
set displayWarningMessage 0
# set useURLibServerFlag 0 ;# try locally first - commented by GJFB in 2017-02-20
# set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} $useURLibServerFlag] ;# commented by GJFB in 2017-02-20
set urlPropertyList [ResolveIBI $parsedIBIURL {} $displayWarningMessage {} 0 $agencyStructureFlag] ;# added by GJFB in 2017-02-20
}
# puts $parsedIBIURL
# puts $unit
# puts --$urlPropertyList--
array set urlPropertyArray $urlPropertyList
# set state $urlPropertyArray(state)
ConditionalSet state urlPropertyArray(state) {}
# if [string equal {Deleted} $state] #
if {[string equal {Deleted} $state] || [string equal {} $state]} {
# deleted or next higher unit not found
unset returnPathArray($i) ;# added by GJFB in 2014-08-02 to solve deleted next higher unit, otherwise one gets duplicated return paths
lappend missingNextHigherUnitIBIList $unit
# puts $missingNextHigherUnitIBIList
continue ;# added by GJFB in 2014-08-02 to solve deleted next higher unit
} else {
ConditionalSet metadataFieldList urlPropertyArray(metadatafieldlist) {} ;# needed by BuildReturnPathArray (see cgi/get.tcl)
}
# puts [list $site $rep $serverAddress $metadataFieldList]
# => marte2.sid.inpe.br dpi.inpe.br/marte2/2013/05.28.22.25.51 {marte2.sid.inpe.br 802} {identifier 3ERPFQRTRW34M/3E7G88S nexthigherunit {} shorttitle {SBSR 16}}
# serverAddress not used
# metadataFieldList contains the values of identifier, nexthigherunit and shorttitle
# puts --$metadataFieldList--
# => identifier 3ERPFQRTRW34M/3E7G88S nexthigherunit {} shorttitle {SBSR 16}
foreach {metadataFieldName metadataFieldValue} $metadataFieldList {
set $metadataFieldName $metadataFieldValue ;# set identifier, nexthigherunit, shorttitle and title (nexthigherunit, shorttitle and title are with respect to identifier)
}
# Create automatic short title
# added by GJFB 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
set site $urlPropertyArray(archiveaddress)
# puts $site
set unitServerAddress [GetServerAddressFromHTTPHost $site]
set encodingName [Execute $unitServerAddress [list GetEncodingName]]
if [string equal {utf-8} $encodingName] {
# solves the accent problem - same code is used in xxDocContent.html
set shorttitle [encoding convertfrom utf-8 $shorttitle] ;# Produção -> Produção - ex: http://www.urlib.net/rep/LK47B6W/362SFKH http://gjfb.home:1905/rep/LK47B6W/362SFKH
}
if [string equal {} $nexthigherunit] {
set returnPathArray($i) [concat [list $identifier $shorttitle] $returnPathArray($i)]
# puts 2-[list $returnPathArray($i) $i]
# => 3ERPFQRTRW34M/3E7G88S {SBSR 16} {} {}
incr i
continue
}
BuildReturnPathArray [list $identifier $nexthigherunit $shorttitle] $agencyStructureFlag
}
}
# BuildReturnPathArray - 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
# ----------------------------------------------------------------------
![](\"http://$localSite/col/$defaultMirrorHomePageRepository/doc/images/ajax-loader.gif\")