# <PRE>
# Copyright for the Uniform Repository Service (c) 1995 - 2000, 2021, 2023, 2024
# by Gerald Banon. All rights reserved.
# Version 2.1
# from.tcl
#
# If the document is in the current local collection, it is returned,
# otherwise it is searched within the scope of the whole URLib
# collection and of the local bibliographic mirror
# (unless the call is done from another mirror) and the
# document corresponding to the official version or the most recent
# metadata last update is returned.
#
# Example:
# /col/inpe.br/gb/1998/08.02.08.56/doc/goto-/inpe.br/gb/1998/08.08.09.10
# PATH_INFO = /inpe.br/gb/1998/08.02.08.56/to-/inpe.br/gb/1998/08.08.09.10

# see reserved file names in iconet.com.br/banon/2008/12.11.01.03 (Testando nome de arquivo e sequência de pastas/arquivo reservados)

proc From {} {
if [catch {
	global env
	
	set ibiResolver $env(SERVER_NAME):$env(SERVER_PORT)
	set nidXresolverArray(rep) $ibiResolver
	set nidXresolverArray(rep-) $ibiResolver
	set nidXresolverArray(ibi) $ibiResolver
	set nidXresolverArray(ibi-) $ibiResolver
#	set nidXresolverArray(urn/ibi) $ibiResolver	;# commented by GJFB in 2023-06-05
	
#	set nidXresolverArray(doi) doi.org	;# commented by GJFB in 2023-12-15
	set nidXresolverArray(urn/doi) doi.org	;# added by GJFB in 2023-12-15 for changing the option doi to urn/doi
#	set nidXresolverArray(purl) purl.archive.org
	set nidXresolverArray(purl) purl.org
		
if 0 {
#	regexp {([^/]*)/([^/]*/[^/]*/[^/]*/[^/]*)$} $env(PATH_INFO) m to currentRep
	if ![regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/([^/]*)/([^/]*/[^/]*/[^/]*/[^/]*.*)$} $env(PATH_INFO) m source to destination] {
		regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/([^/]*)/([^/]*/[^/]*.*)$} $env(PATH_INFO) m source to destination;# added by GJFB in 2021-10-08 to resolve IBIp e IBIn
	}
#	regsub {to} $to {rep} nameSpaceID	;# nameSpaceID value is rep- or rep	;# commented by GJFB in 2021-10-09
	regsub {to} $to {ibi} nameSpaceID	;# nameSpaceID value is ibi- or ibi	;# added by GJFB in 2021-10-09
} elseif 0 {
# added by GJFB in 2021-10-09
	if ![regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*)/([^/]*/[^/]*/[^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination] {
		regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*)/([^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination	;# added by GJFB in 2021-10-08 to resolve IBIp, IBIn e doi
	}
# nameSpaceID value is goto-, goto, ibi-, ibi or doi	;# added by GJFB in 2021-10-09
#	regsub {goto|to} $nameSpaceID {rep} nameSpaceID	;# nameSpaceID value is rep- or rep	;# comented by GJFB in 2021-10-28
	regsub {goto} $resolverID {rep} resolverID	;# nameSpaceID value is rep- or rep
} else {
# added by GJFB in 2021-11-20
if 0 {
# commented by GJFB in 2023-06-05
	if ![regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*|urn/[^/]*)/([^/]*/[^/]*/[^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination] {
		regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*|urn/[^/]*)/([^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination	;# added by GJFB in 2021-11-17 to resolve urn
	}
} elseif 0 {
# added by GJFB in 2023-06-05 - commented by GJFB in 2023-12-15
	if ![regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*|fullypersistenthref/[^/]*)/([^/]*/[^/]*/[^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination] {
		regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*|fullypersistenthref/[^/]*)/([^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination	;# added by GJFB in 2021-11-17 to resolve urn
	}
} else {
# added by GJFB in 2023-12-15 for changing the option doi to urn/doi
	if ![regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*|urn/[^/]*)/([^/]*/[^/]*/[^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination] {
		regexp {/([^/]*/[^/]*/[^/]*/[^/]*)/to/([^/]*|urn/[^/]*)/([^/]*/[^/]*.*)$} $env(PATH_INFO) m source resolverID destination	;# added by GJFB in 2021-11-17 to resolve urn
	}
}
	regsub {goto} $resolverID {rep} resolverID	;# nameSpaceID value is rep- or rep
}

if 0 {	 	
	puts {Content-Type: text/html}
	puts {}
	puts $env(PATH_INFO)	;# => /urlib.net/www/2023/06.03.21.17/to/ibi/8JMKD3MGP3W34R/44C25PS
							;# => /urlib.net/www/2023/06.03.21.17/to/urn/doi/10.17487/RFC8141
	puts <BR>
	puts $source		;# => urlib.net/www/2023/06.03.21.17
						;# => urlib.net/www/2023/06.03.21.17
	puts <BR>
	puts $resolverID	;# => ibi
						;# => urn/doi
	puts <BR>
	puts $destination	;# 8JMKD3MGP3W34R/44C25PS
}

	if {[info exists env(QUERY_STRING)] && [string compare {} $env(QUERY_STRING)] != 0} {
#		set queryString ?$env(QUERY_STRING)	;# commented by GJFB in 2021-10-08
#		set queryString ?$env(QUERY_STRING)&linktype=relative	;# added by GJFB in 2021-10-08 - linktype is used in ReturnURLPropertyList2	- commented by GJFB in 2024-01-04
		set queryString ?$env(QUERY_STRING)&ibiurl.clientinformation.citingitem=$source&linktype=relative	;# added by GJFB in 2021-10-08 - linktype is used in ReturnURLPropertyList2	- added by GJFB in 2024-01-04
	} else {
#		set queryString {}	;# commented by GJFB in 2021-10-08
#		set queryString ?linktype=relative	;# added by GJFB in 2021-10-08 - linktype is used in ReturnURLPropertyList2	- commented by GJFB in 2024-01-04
		set queryString ?ibiurl.clientinformation.citingitem=$source&linktype=relative	;# added by GJFB in 2021-10-08 - linktype is used in ReturnURLPropertyList2	- added by GJFB in 2024-01-04
	}

if [string equal {urn/ibi} $resolverID] {
	puts "Location: http://$ibiResolver/customizeerror.cgi/602"
	puts ""
}

	set nameSpaceID [lindex [file split $resolverID] end]	;# urn/doi -> doi
	if [regexp {^(ibi|rep)$} $nameSpaceID] {
# ibi or rep
		set link $nidXresolverArray($resolverID)/$nameSpaceID/$destination$queryString
	} elseif {[regexp {^doi$} $nameSpaceID]} {	;# added by GJFB in 2023-11-11 to display a copy (if any) of the item identified by its doi
# doi
		global serverAddress	;# used by SetFieldValue
		set col ../../../../..
		set URLibServiceRepository $env(URLIB_SERVICE_REP)
		source ../$col/$URLibServiceRepository/doc/utilities1.tcl
		source ../$col/$URLibServiceRepository/doc/utilitiesMirror.tcl
		source ../$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 not found
			set link $nidXresolverArray($resolverID)/$destination$queryString
		} else {
# a copy was found
			foreach {site rep-i} [lindex $resultList 0] {break}			
#			puts --$site--
#			puts --${rep-i}--
			SetFieldValue $site ${rep-i} identifier
#			puts --$identifier--
			set link $nidXresolverArray(ibi)/ibi/$identifier$queryString
		}		
	} else {
# ibi-, rep-, purl...
		set link $nidXresolverArray($resolverID)/$destination$queryString
	}

if 0 {
# testing 'Example of robust hypertext and authentic data' (QABCDSTQQW/4AEFPDB)	when GetOptimizedListOfSites was executed using MultipleExecute
	set homePath $env(DOCUMENT_ROOT)
	set col ../../../../..
	set URLibServiceRepository $env(URLIB_SERVICE_REP)
	source ../$col/$URLibServiceRepository/doc/utilities1.tcl
	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
	}
}
	
	puts "Location: http://$link"
	puts ""
} m] {
	if ![string equal {} $m] {
		puts {Content-Type: text/html}
		puts {}
		puts "<PRE>from: $m</PRE>"
		if 0 {global errorInfo; puts <PRE>$errorInfo</PRE>}
	}
}
}
# </PRE>