#
# Copyright for the Uniform Repository Service (c) 1995 - 2025
# by Gerald Banon. All rights reserved.
# Version 2.1
# resolve.tcl
#
# Created by GJFB in 2025-09-06 from an old version of from.tcl
#
# If the document is in the distributed collection defined by the local bibliographic mirror
# (unless the call is done from another mirror), it is returned,
# otherwise it is searched within the scope of the whole URLib collection
#
# Examples:
if 0 {
	http://mtc-m12.sid.inpe.br/urn:doi:10.17487/RFC8141?ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17&linktype=relative
	http://urlib.net/urn:doi:10.17487/RFC8141?ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17&linktype=relative
	http://gjfb0520.sid.inpe.br/urn:doi:10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative
	http://gjfb:1905/urn:doi:10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative
# in both URL below upn:4CR88AP no longer exist
#	http://gjfb:1905/upn:4CR88AP:QABCDSTQQW/4BT93R5?ibiurl.clientinformation.citingitem=iconet.com.br/banon/2001/04.28.19.50&linktype=relative
#	http://gjfb:1905/upn:4CR88AP-:QABCDSTQQW/4BT93R5?ibiurl.clientinformation.citingitem=iconet.com.br/banon/2001/04.28.19.50&linktype=relative
}
# this sort of URL must call the solve cgi script

proc Resolve {} {
if [catch {
	global env

## OBS: resolverID == uriPrefix (values are not upn:4CR88AP but can be relative to IBI, e.g. upn:4E9948J initially from mtc-m21c.sid.inpe.br))
# OBS: resolverID == uriPrefix (values are not ibi but can be relative to IBI, e.g. upn:4E9948J initially from mtc-m21c.sid.inpe.br))

# resolverID and destination
#	regexp {^/(.+:.+):(.+)$} $env(PATH_INFO) m resolverID destination ;# used with urn:doi only
	regexp {([^/]+):(.+)$} $env(PATH_INFO) m resolverID destination	;# used with urn:doi and doi

# ibiResolver (localSite)
	set ibiResolver $env(SERVER_NAME):$env(SERVER_PORT)
# homePath
	set homePath $env(DOCUMENT_ROOT)
# URLibServiceRepository
	set URLibServiceRepository $env(URLIB_SERVICE_REP)
# localSite
	set localSite $env(SERVER_NAME):$env(SERVER_PORT)
	
	source $homePath/col/$URLibServiceRepository/doc/utilities1.tcl	;# StoreArray
		
if 0 {	 	
	puts {Content-Type: text/html}
	puts {}
	puts $env(PATH_INFO)	;# => /urn:doi:10.17487/RFC8141

	puts 
puts $resolverID ;# => urn:doi puts
puts $destination ;# 10.17487/RFC8141 } # Store xxx C:/tmp/bbb.txt auto 0 a if {[info exists env(QUERY_STRING)] && [string compare {} $env(QUERY_STRING)] != 0} { set queryString ?$env(QUERY_STRING) } else { set queryString {} } if ![info exists resolverID] { puts "Location: http://$ibiResolver/customizeerror.cgi/603" puts "" return } if [string equal {urn:ibi} $resolverID] { puts "Location: http://$ibiResolver/customizeerror.cgi/602" puts "" } if 0 { puts
puts --$queryString-- ;# => --?ibiurl.clientinformation.citingitem=urlib.net/www/2023/06.03.21.17-- } if 0 { set url http://$localSite/ibi/$destination$queryString puts "Location: $url" puts "" return } package require http set startingTime 02:00:00 set startingSecond [clock scan $startingTime -base 109306800] set seconds [clock seconds] set timePeriod [expr 24*60*60] ;# 1 day # 1 namespacePrefixXresolverURLarray if 0 { # manual update of namespacePrefixXresolverURLarray set namespacePrefixXresolverURLarray(upn:4CR88AP) $ibiResolver ;# added by GJFB in 2025-06-11 set namespacePrefixXresolverURLarray(upn:4CR88AP-) $ibiResolver ;# added by GJFB in 2025-06-11 set namespacePrefixXresolverURLarray(urn:doi) doi.org ;# added by GJFB in 2023-12-26 # set namespacePrefixXresolverURLarray(purl) purl.org } else { # automatic update of namespacePrefixXresolverURLarray if [file exists $homePath/col/$URLibServiceRepository/auxdoc/namespacePrefixXresolverURLarray.tcl] { source $homePath/col/$URLibServiceRepository/auxdoc/namespacePrefixXresolverURLarray.tcl ;# set namespacePrefixXresolverURLarray cache } ConditionalSet outputValue namespacePrefixXresolverURLarray($resolverID) {} # similar code in ComputeFileUpdateFlag set mtime [lindex $outputValue 1] if [string equal {} $mtime] {set mtime 0} if {[expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} { # since the last update (mtime), at least one transition time has occured # where the transition times is = {starting second + n * time period: n = 0, 1, ...} # old array input value, the input value should be updated # UPDATE # see: Returning the resolver URL of a given namespace prefix # set url http://gjfb:1905/col/urlib.net/www/2025/09.08.04.08/doc/script.cgi?upn:4E9948J # set url http://$ibiResolver/col/urlib.net/www/2025/09.08.04.08/doc/script.cgi?$resolverID set url http://urlib.net/col/urlib.net/www/2025/09.08.04.08/doc/script.cgi?$resolverID if [catch {http::geturl $url} token] { # nothing to do } else { if {[http::ncode $token] == 200} { set data [string trim [http::data $token]] ;# trim is a must if [string equal {} $data] { if [info exists namespacePrefixXresolverURLarray($resolverID)] {unset namespacePrefixXresolverURLarray($resolverID)} } else { set namespacePrefixXresolverURLarray($resolverID) [list $data $seconds] ;# update namespacePrefixXresolverURLarray cache } StoreArray namespacePrefixXresolverURLarray $homePath/col/$URLibServiceRepository/auxdoc/namespacePrefixXresolverURLarray.tcl w list array 1 file delete $homePath/col/$URLibServiceRepository/auxdoc/uriPrefixXresolverURLarray.tcl ;# migration uriPrefixXresolverURLarray.tcl -> namespacePrefixXresolverURLarray.tcl - 2025-10-14 } http::cleanup $token } # UPDATE - end } else { # nothing to do } } ConditionalSet outputValue namespacePrefixXresolverURLarray($resolverID) {} set resolverURL [lindex $outputValue 0] if 0 { puts
puts --$resolverURL-- } # 2 IBInamespacePrefixList # automatic update of IBInamespacePrefixList if [file exists $homePath/col/$URLibServiceRepository/auxdoc/IBInamespacePrefixList.tcl] { source $homePath/col/$URLibServiceRepository/auxdoc/IBInamespacePrefixList.tcl ;# set IBInamespacePrefixList cache } else { set IBInamespacePrefixList {} } # similar code in ComputeFileUpdateFlag set mtime [lindex [lsearch -index 0 -inline $IBInamespacePrefixList $resolverID] 1] if [string equal {} $mtime] {set mtime 0} if {[expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} { # since the last update (mtime), at least one transition time has occured # where the transition times is = {starting second + n * time period: n = 0, 1, ...} # old array input value, the input value should be updated # UPDATE # see: Confirming the existence of a given namespace prefix for the IBI namespace # set url http://gjfb:1905/col/urlib.net/www/2025/09.20.21.06/doc/script.cgi?$resolverID set url http://urlib.net/col/urlib.net/www/2025/09.20.21.06/doc/script.cgi?$resolverID if [catch {http::geturl $url} token] { # nothing to do } else { if {[http::ncode $token] == 200} { set flag [http::data $token] # puts --$flag-- if $flag { lappend IBInamespacePrefixList [list $resolverID $seconds] set IBInamespacePrefixList [lsort -unique -index 0 $IBInamespacePrefixList] } else { set index [lsearch -index 0 $IBInamespacePrefixList $resolverID] set IBInamespacePrefixList [lreplace $IBInamespacePrefixList $index $index] } set fileContent "set IBInamespacePrefixList [list $IBInamespacePrefixList]" Store fileContent $homePath/col/$URLibServiceRepository/auxdoc/IBInamespacePrefixList.tcl file delete $homePath/col/$URLibServiceRepository/auxdoc/IBIuriPrefixList.tcl ;# migration IBIuriPrefixList.tcl -> IBInamespacePrefixList.tcl - 2025-10-14 } http::cleanup $token } # UPDATE - end } else { # nothing to do } if [string equal {} $resolverURL] { puts "Location: http://$ibiResolver/customizeerror.cgi/603" ;# must be after # 2 IBInamespacePrefixList to do replace puts "" return } if {[lsearch -index 0 $IBInamespacePrefixList $resolverID] != -1} { # an IBI resolver if [string equal {-} [string index $resolverID end]] { set url $resolverURL/IBI-:$destination$queryString } else { set url $resolverURL/IBI:$destination$queryString } puts "Location: $url" puts "" return } # if [regexp {^ibi-?$} $resolverID] # ;# added by GJFB in 2023-11-11 to display a copy (if any) of the item identified by its doi - added by GJFB in 2025-06-29 if {0 && [regexp {^ibi-?$} $resolverID]} { ;# added by GJFB in 2023-11-11 to display a copy (if any) of the item identified by its doi - added by GJFB in 2025-06-29 # set link $localSite/$resolverID:$destination$queryString set url http://$localSite/$resolverID:$destination$queryString } elseif {[regexp {^(urn:doi|doi)$} $resolverID]} { ;# added by GJFB in 2023-11-11 to display a copy (if any) of the item identified by its doi - added by GJFB in 2025-06-29 # urn:doi or doi global serverAddress ;# used by SetFieldValue # source $homePath/col/$URLibServiceRepository/doc/utilities1.tcl source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl source $homePath/col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl # serverAddress set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)] set resultList [FindMetadataRepositories "doi $destination" 0 {} {} no no 1] if 0 { puts {Content-Type: text/html} puts {} puts --$resultList-- } if [string equal {} $resultList] { # no copies of the item identified by its doi were found in the URLib collection set url $resolverURL/$destination$queryString ;# use doi } else { # a copy was found if [catch {http::geturl http://doi.org/} token] { ;# if added by GJFB in 2025-06-29 # site not found - use the copy foreach {site rep-i} [lindex $resultList 0] {break} # puts --$site-- # puts --${rep-i}-- SetFieldValue $site ${rep-i} identifier # puts --$identifier-- # set link $namespacePrefixXresolverURLarray(upn:4CR88AP)/upn:4CR88AP:$identifier$queryString ;# use ibi copy set url http://urlib.net/ibi:$identifier$queryString ;# use ibi copy } else { # use the original - added by GJFB in 2025-06-29 http::cleanup $token set url $resolverURL/$destination$queryString ;# use doi } } } else { ## upn:4CR88AP or upn:4CR88AP- or ibi or ibi- or ark or ... # ark or ... set url $resolverURL/$resolverID:$destination$queryString } if 0 { # testing 'Example of robust hypertext and authentic data' (QABCDSTQQW/4AEFPDB) when GetOptimizedListOfSites was executed using MultipleExecute if [file exists $homePath/fileFlag] { # set xWaitQueue 0; after 1000 {set xWaitQueue 1}; vwait xWaitQueue set xWaitQueue 0; after 2000 {set xWaitQueue 1}; vwait xWaitQueue ;# OK } else { set x x Store x $homePath/fileFlag } } # location http://doi.org/10.17487/RFC8141 gerado em solve puts "Location: $url" puts "" # => Location: http://doi.org/10.1590/0001-3765202320210807?ibiurl.clientinformation.citingitem=urlib.net/www/2023/11.16.13.37&linktype=relative } m] { if ![string equal {} $m] { puts {Content-Type: text/html} puts {} puts "
Resolve: $m
" if 0 {global errorInfo; puts
$errorInfo
} } } } #