# Copyright for the Uniform Repository Service (c) 1995 - 2022,
# by Gerald Banon. All rights reserved.
# Version 2.1
# cover.tcl
# Examples:
# http://banon-pc2/cover/dpi.inpe.br/banon/1998/08.02.08.56
# http://banon-pc2/cover/dpi.inpe.br/banon/1998/08.02.08.56/Cover
# http://banon-pc2/cover/dpi.inpe.br/banon/1998/08.02.08.56/BannerSpace
proc Cover {} {
if [catch {
global env
global cgi ;# used in ResolveIBI called by FindSite2
global col
# the line below is commented in order to disregard the parent repositories
# global referenceTable ;# used by FindParentList called by CreateCitedRepositoryList called by RepositoryMTime
global loCoInRep ;# used by FindParentList called by CreateCitedRepositoryList called by RepositoryMTime
global loBiMiRep ;# used in FindURLPropertyList called by ResolveIBI
global mirrorHomePageRep ;# defined in FindLanguage (utilities1.tcl)
global versionRegistrationTime
global hostCollectionSite
global homePath ;# used in FindLanguage
global URLibServiceRepository
global serverAddress ;# used in FindURLPropertyList called by ReturnURLPropertyList called by ReturnURLPropertyList2 called by ResolveIBI called by FindSite2
global localSite ;# used by ResolveIBI in "error $output"
global serverAdministratorAddress ;# used in FindURLPropertyList
if 0 {
puts {Content-Type: text/html}
puts {}
}
set col ../../../../..
set URLibServiceRepository $env(URLIB_SERVICE_REP)
source ../$col/$URLibServiceRepository/doc/utilities1.tcl
source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl
# the line below is commented in order to disregard the parent repositories
# source $env(DOCUMENT_ROOT)/col/$URLibServiceRepository/auxdoc/.referenceTable.tcl
set loCoInRep $env(LOCOINREP) ;# used by FindParentList called by CreateCitedRepositoryList called by RepositoryMTime
# homePath (used in FindLanguage)
set homePath $env(DOCUMENT_ROOT)
if [info exists env(QUERY_STRING)] {
foreach {name value} [split $env(QUERY_STRING) &=] {
set cgi([DecodeURL $name]) [DecodeURL $value]
}
}
# if ![info exists cgi(mirror)] {set cgi(mirror) $env(LOBIMIREP)}
ConditionalSet requiredMirror cgi(requiredmirror) $env(LOBIMIREP)
if ![info exists cgi(languagebutton)] {set cgi(languagebutton) {}}
set pathInfo [file split $env(PATH_INFO)]
# currentRep
regsub -all { } [lrange $pathInfo 1 4] {/} currentRep
regexp {([^+]*)(\+)?} $currentRep m currentRep plus
# Find the language and the language repository
# use the same languages as the ones used for the local bibliographic mirror
foreach {language languageRep1 languageRep2} [FindLanguage $requiredMirror] {break}
# Find the language and the language repository - end
# bgColor, background and bgProperties
foreach {bgColor background bgProperties fontTag fontTag2} [GetBg $languageRep1 $language] {break}
#set background http://$env(DOCUMENT_ROOT)/col/$env(LOBIMIREP)/doc/$background
source ../$col/$languageRep2/doc/mirror/${language}Cover.tcl
# serverAddress
set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# urlibServerAddress
set urlibServerAddress $env(URLIB_SERVER_ADDR) ;# urlib.net and port
# localSite
set localSite $env(SERVER_NAME):$env(SERVER_PORT) ;# used in the document not found warning
# loBiMiRep
set loBiMiRep $env(LOBIMIREP)
# serverAdministratorAddress
set serverAdministratorAddress $env(SERVER_ADMIN)
# sampledDocumentDBServerAddress
set sampledDocumentDBServerAddress [Execute $serverAddress GetSampledDocumentDBServerAddress]
set similarityFlag [string equal {+} $plus]
set displayWarningMessage 1
# set siteRep [FindSite2 $currentRep $similarityFlag $language]
# if [catch {FindSite2 $currentRep $similarityFlag $language} siteRep] #
if [catch {FindSite2 $currentRep $similarityFlag $language 0 $displayWarningMessage} siteRep] {
puts {Content-Type: text/html}
puts {}
puts $siteRep
return
}
if {[llength [lindex $siteRep 1]] > 1} {
# there is at least one unfair site
# an investigation must be done
set hostSiteList {}
foreach hostSiteRep $siteRep {
lappend hostSiteList [lindex $hostSiteRep 0]
}
puts {Content-Type: text/html}
puts {}
puts "Cover: the sites $hostSiteList are disputing the repository: $currentRep"
puts
puts {Please inform urlibservice@gmail.com.}
return
}
# serverAddress
# foreach {serverAddress currentRep} $siteRep {break}
# set serverAddress [ReturnCommunicationAddress $serverAddress] ;# mtc-m18.sid.inpe.br:80 -> {mtc-m18.sid.inpe.br 800}
# puts $siteRep
# foreach {site currentRep} $siteRep {break}
# set serverAddress [ReturnCommunicationAddress $site] ;# mtc-m18.sid.inpe.br:80 -> {mtc-m18.sid.inpe.br 800}
# foreach {site currentRep serverAddress} $siteRep {break} ;# added by GJFB in 2013-08-16 - to work with virtual host
foreach {site currentRep} $siteRep {break}
set serverAddress [GetServerAddressFromHTTPHost $site]
# serverAddress2
regsub { +} $serverAddress {+} serverAddress2
## site
# set site [ReturnHTTPHost $serverAddress]
if {$serverAddress != "$env(SERVER_NAME) $env(URLIB_PORT)"} {
puts "Location: http://$site/cover/$currentRep"
puts ""
return
}
if [regexp {/$} $env(PATH_INFO)] {
set frameName ""
} else {
set frameName [lindex $pathInfo end]
}
switch -exact -- $frameName {
BannerSpace {
puts {Content-Type: text/html}
puts {}
set output [CreateBannerSpace $languageRep1 $language]
}
Cover {
puts {Content-Type: text/html}
puts {}
# puts [array get cgi]
# if ![info exists cgi(targetframe)] {set cgi(targetframe) _parent} ;# used to return the confirmation warning after an update from the full form
# regexp {(.*):(.*)} $site m serverName portNumber
foreach {serverName urlibPort} [ReturnCommunicationAddress $serverAddress] {break}
set localURLibClientSocketId [StartCommunication $serverName $urlibPort]
if ![info exists cgi(metadatarepository)] {
# Find metadataRep in the appropriate language
# set parsedIBIURL [list parsedibiurl.ibitype rep parsedibiurl.ibi $currentRep parsedibiurl.verblist GetAppropriateMetadata]
set parsedIBIURL [list parsedibiurl.ibi $currentRep parsedibiurl.verblist GetMetadata]
set urlPropertyList2 [ResolveIBI $parsedIBIURL $language 1]
array set urlPropertyArray $urlPropertyList2
set metadataRep $urlPropertyArray(repository) ;# metadataRep in the appropriate language
# Find metadataRep in the appropriate language - end
} else {
set metadataRep $cgi(metadatarepository)
}
set versionStamp [Submit $localURLibClientSocketId [list GetLastUpdate $metadataRep-0] 0] ;# not async
set referenceType [Submit $localURLibClientSocketId [list ReturnType metadataArray $metadataRep-0] 0] ;# not async
set title [Submit $localURLibClientSocketId [list GetFieldValue $metadataRep-0 title] 0] ;# not async
set authorList [Submit $localURLibClientSocketId [list GetAuthor $metadataRep-0] 0] ;# not async
set year [Submit $localURLibClientSocketId [list GetFieldValue $metadataRep-0 year] 0] ;# not async
set previousEdition [Submit $localURLibClientSocketId [list GetFieldValue $metadataRep-0 previousedition] 0] ;# not async
set nextEdition [Submit $localURLibClientSocketId [list GetFieldValue $metadataRep-0 nextedition] 0] ;# not async
set authorHomePageRep [Submit $localURLibClientSocketId [list GetAuthorHomePage $currentRep] 0] ;# not async
set author [FormatAuthorList $authorList]
if {[string compare {} $authorHomePageRep] != 0} {
regsub {([^,]*),} [EscapeUntrustedData $author] "\\1," author
}
set author "$author :$year:"
set metadataLastUpdate [Submit $localURLibClientSocketId [list GetMetadataLastUpdate $metadataRep-0] 0] ;# not async
regsub -all { } $metadataLastUpdate {+} metadataLastUpdate2
# set versionState [Submit $localURLibClientSocketId [list ComputeVersionState $currentRep $cgi(mirror)]]
# set versionState [Submit $localURLibClientSocketId [list ComputeVersionState $currentRep $env(LOCOINREP)]]
# set versionState [Submit $localURLibClientSocketId [list ComputeVersionState $currentRep]]
set versionState [Submit $localURLibClientSocketId [list ComputeVersionState $currentRep {} 1] 0] ;# not async
set docPermission [Submit $localURLibClientSocketId [list GetPermission doc] 0] ;# not async
set currentDownloadPermission [Submit $localURLibClientSocketId [list FindCurrentDownloadPermission $currentRep] 0] ;# not async
close $localURLibClientSocketId
# set sampledDocumentDBServerAddress 150.163.8.245:1905
# set urlibServerAddress 150.163.8.245:1905
# versionRegistrationTime
set query [list list GetVersionRegistrationTime $currentRep $versionStamp]
# MULTIPLE SUBMIT
set versionRegistrationTime {}
MultipleSubmit {} $query versionRegistrationTime 1 $sampledDocumentDBServerAddress
# set versionRegistrationTime {2002:07.22.13.30.08 iconet.com.br/banon/2002/02.25.18.51}
# hostCollectionSite
set query [list list GetHostCollectionSite $currentRep]
# MULTIPLE SUBMIT
set hostCollectionSite {}
# MultipleSubmit {} $query hostCollectionSite 0 [list $urlibServerAddress]
MultipleSubmit {} $query hostCollectionSite 1 [list $urlibServerAddress]
set hostCollectionSite [join $hostCollectionSite] ;# {banon-pc.dpi.inpe.br 19050} or banon-pc.dpi.inpe.br:1905
regsub -all {(\[|\])} $title {\\\\\\\1} title ;# [1] -> \\\[1\\\] (they are three substitutions below)
# regsub -all {\$} $title {\\\\\\$} title ;# cr$30 -> cr\$30
foreach {state officialSite imageURL} $versionState {break}
# puts $state
array set stateTable {
{Registered Original} {Official}
{Modified Original} {Modified}
{Copy of the Registered Original} {Official}
{Copy of an Original} {Copied}
{Modified Copy of an Original} {Modified}
{Unchecked} {Unchecked}
}
set state $stateTable($state)
# checkWarning
set checkWarning "\${
After your visit,\
returning to this page, you can\
\
check
\
if the document has been changed during the access.
" } else { global "${languageRep2}::Copyright" set copyright " " } # Copyright - end # size Load $env(DOCUMENT_ROOT)/col/$currentRep/service/size size set size [lindex $size 0] if {$size <= 1} { global "${languageRep2}::Kbyte" set size "$size $Kbyte" } else { global "${languageRep2}::Kbytes" set size "$size $Kbytes" } # Create warning set warning "" Load $env(DOCUMENT_ROOT)/col/$currentRep/service/docPermission currentDocPermission set currentDocPermission [lindex [split $currentDocPermission \n] end] if {$currentDocPermission == ""} { set currentDocPermission [lindex [split $docPermission \n] end] } if ![regexp {allow from all} $currentDocPermission] { set warning "$warning\${
After your visit,\
returning to this page, you can\
\
check
\
if the document has been changed during the access.
$m; if 0 {global errorInfo; puts
$errorInfo}} }