# Copyright for the Uniform Repository Service (c) 1995 - 2023, # by Gerald Banon. All rights reserved. # Version 2.1 # copyright.tcl # Example: # PATH_INFO = /dpi.inpe.br/banon/1998/08.02.08.56/ # http://gjfb:1905/copyright.cgi/dpi.inpe.br/banon/1998/08.02.08.56 # the copyrights need not to be in the local collection # the copyrights are searched over the net # ---------------------------------------------------------------------- # Copyright proc Copyright {} { if [catch { global env global cgi ;# used in ResolveIBI called by FindSite2 global homePath ;# used in FindLanguage global URLibServiceRepository global localSite ;# used by ResolveIBI in "error $output" global serverAddress ;# used in SetFieldValue global loCoInRep ;# used in FormatSiteList called by FindURLPropertyList called by ReturnURLPropertyList called by ReturnURLPropertyList2 called by ResolveIBI global loBiMiRep ;# used in FindURLPropertyList called by ResolveIBI global serverAdministratorAddress ;# used in FindURLPropertyList # set cgi(mirror) $env(LOBIMIREP) ;# used in ReturnURLPropertyList set cgi(requiredmirror) $env(LOBIMIREP) ;# used in ReturnURLPropertyList set col ../../../../.. set URLibServiceRepository $env(URLIB_SERVICE_REP) set copyrightWarningRepository dpi.inpe.br/banon/2000/02.20.10.08 source ../$col/$URLibServiceRepository/doc/utilities1.tcl source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl # homePath (used in FindLanguage) set homePath $env(DOCUMENT_ROOT) # loCoInRep set loCoInRep $env(LOCOINREP) 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)} set pathInfo [file split $env(PATH_INFO)] # currentRep regsub -all { } [lrange $pathInfo 1 4] {/} currentRep # language foreach {language languageRep1 languageRep2} [FindLanguage $env(LOBIMIREP)] {break} # serverAddress set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)] # localSite set localSite $env(SERVER_NAME):$env(SERVER_PORT) # loBiMiRep set loBiMiRep $env(LOBIMIREP) # serverAdministratorAddress set serverAdministratorAddress $env(SERVER_ADMIN) if ![file isdirectory $homePath/col/$currentRep] { ;# added by GJFB in 2020-01-02 # currentRep doesn't exist # REDIRECT - a warning message will be displayed puts "Location: http://$localSite/$currentRep?ibiurl.backgroundlanguage=$language" puts "" return } puts {Content-Type: text/html} puts {} set metadataRep [Execute $serverAddress [list FindMetadataRep $currentRep]] SetFieldValue $serverAddress $metadataRep-0 {year rightsholder} ;# used in Puts # set copyrightRepositoryList [Execute $serverAddress [list FindCopyrightRepositories $currentRep]] ;# find the repositories containing the copyrights (in the first language) ;# commented by GJFB in 2015-07-30 - now the approriate repository is found in FindCopyrightRepositories set copyrightRepositoryList [Execute $serverAddress [list FindCopyrightRepositories $currentRep $language]] ;# find the repositories containing the copyrights in the appropriate language) ;# added by GJFB in 2015-07-30 - now the approriate repository is found in FindCopyrightRepositories if [regexp "^<(.*)>$" $copyrightRepositoryList m errorMessage] { puts "
Copyright: \[FindCopyrightRepositories $currentRep $language\] executed in [list $serverAddress] returns:" puts
$errorMessagereturn } array set copyrightRepositoryArray $copyrightRepositoryList # multiple copyrights # Puts # puts [array get copyrightRepositoryArray] # puts $language set flag 1 ;# no copyright found set copyrightRepositories [array names copyrightRepositoryArray] set n [llength $copyrightRepositories] set i 1 foreach copyrightRep $copyrightRepositories { if 0 { # commented by GJFB in 2015-07-30 - now the approriate repository is found in FindCopyrightRepositories # puts [list FindSite2 $copyrightRep 1 $language] set siteRep [FindSite2 $copyrightRep 1 $language] ;# find rep in the appropriate language # puts --$siteRep-- } else { # added by GJFB in 2015-07-30 - now the approriate repository is found in FindCopyrightRepositories set siteRep [FindSite2 $copyrightRep] } if {$siteRep == {}} {continue} ;# site not found foreach {site rep} $siteRep {break} Puts $site $rep $i $n set flag 0 incr i } if $flag { # no copyright found, use the default Puts $serverAddress $copyrightWarningRepository 1 1 } # puts $flag # OK button if {[info exists cgi(displayokbutton)] && [string equal {yes} $cgi(displayokbutton)]} { set targetFile [Execute $serverAddress [list GetTargetFile $currentRep]] puts "
$m; if 0 {global errorInfo; puts
$errorInfo}} } # Copyright - end # ---------------------------------------------------------------------- # Puts proc Puts {site rep i n} { global cgi global env upvar localSite localSite upvar languageRep1 languageRep1 upvar copyrightRepositoryArray copyrightRepositoryArray upvar year year ;# may be used in fileContent upvar rightsholder rightsholder ;# may be used in fileContent set serverAddress [GetServerAddressFromHTTPHost $site] set fileContent [Execute $serverAddress [list ReturnTargetFileContent $rep]] set fileContent [join $fileContent \n] set encodingName [Execute $serverAddress [list GetEncodingName]] ;# added by GJFB in 2010-11-24 set fileContent [encoding convertfrom $encodingName $fileContent] ;# added by GJFB in 2010-11-24 - solves the accent problem - when opening copyright from plutao which uses utf-8 if {$n > 1} { puts "
$i/$n - copyright repository <\;$rep>\; for:
" foreach repository-title-auhtor $copyrightRepositoryArray($rep) { lappend docList "<\;${repository-title-auhtor}>\;" } puts "[join $docList
]
$fileContent} } # Puts - end # ----------------------------------------------------------------------