# Copyright for the Uniform Repository Service (c) 1995 - 2023,
# by Gerald Banon. All rights reserved.
# Version 2.1
# mirrorsearch.tcl
# example:
# http://banon-pc2/col/dpi.inpe.br/banon/1999/06.19.17.00/doc/mirrorsearch.cgi?languagebutton=pt-BR&returnbutton=yes&query=ti+clipping*&choice=briefTitleAuthor&linktype=2&cssfileurl=http://banon-pc2/col/dpi.inpe.br/banon/1999/06.19.22.43/doc/mirrorStandard.css
# ----------------------------------------------------------------------
# MirrorSearch
proc MirrorSearch {} {
if [catch {
if 0 {
# testing progressive loading
puts {Content-Type: text/html}
puts {}
puts 1
puts "" ;# to have the previous puts displayed
set x 0; after 1000 {set x 1}; vwait x
puts 2
return
}
global currentProcedureName ;# used in LoopOverEntries
# global currentFileName ;# used in CreateOutput and LoopOverEntries
global currentProcedureFileName ;# used in CreateOutput and LoopOverEntries
global env
global cgi
global currentRep
global language
# global administratorUserName ;# used in CreateReturnButton
global homePath ;# used in CreateOutput and FindLanguage
global URLibServiceRepository ;# used in MultipleSubmit (called in MultipleExecute2 called in CreateOutput)
global queueLengthFlag ;# used in MultipleSubmit (called in MultipleExecute2 called in CreateOutput)
global serverAddressWithIP ;# used in SynchronizeRepository called in sourceDisplayControl
global mirrorHomePageRepository ;# used in LoopOverEntries to access submission.js
# array set environment [array get env] ;# used in MultipleSubmit
set col ../../../../..
set URLibServiceRepository dpi.inpe.br/banon/1998/08.02.08.56
source ../$col/$URLibServiceRepository/doc/utilities1.tcl
source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl
source ../$col/$URLibServiceRepository/doc/utilitiesMirror.tcl ;# FindIdentifierNameFromIBI
# 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)
if 0 {
puts {Content-Type: text/html}
puts {}
puts ok4
puts "" ;# to have the previous puts displayed
# return
}
# homePath (used in CreateReturnButton and FindLanguage)
set homePath $env(DOCUMENT_ROOT)
# pathInfo
if [info exists env(PATH_INFO)] {
set pathInfo [file split $env(PATH_INFO)]
} else {
set pathInfo [file split /$env(LOBIMIREP)]
}
# currentRep
regsub -all { } [lrange $pathInfo 1 4] {/} currentRep
# mirrorIdentifier (childIdentifier)
set mirrorIdentifier [FindIdentifierNameFromIBI $currentRep] ;# added by GJFB in 2022-06-13
set display [GetFrameName] ;# added by GJFB in 2020-06-19 - used when setting window.name javascript property in cgi/submit mirror/xxSubmit.tcl and xxUpdateSubmission.html
set currentProcedureName MirrorSearch
# set currentFileName $homePath/col/$URLibServiceRepository/doc/cgi/mirrorsearch.tcl
set currentProcedureFileName $homePath/col/$URLibServiceRepository/doc/cgi/mirrorsearch.tcl
# set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)]
# serverAddressWithIP
set serverAddressWithIP [list $env(IP_ADDR) $env(URLIB_PORT)]
# administratorUserName
## regsub {@.*$} $env(SERVER_ADMIN) {} administratorUserName
# set administratorUserName administrator
# Find the language and the language repository
foreach {language languageRep1 languageRep2 firstLanguageRep \
submissionFormRep submissionFormLanguage submissionFormLanguageRep} \
[FindLanguage $currentRep] {break}
# Find the language and the language repository - end
# used with GET
# doesn't hidden password1 and codedpassword1
if [info exists env(QUERY_STRING)] {
if [regexp {^(.*)&(returnaddress)=(.+)$} $env(QUERY_STRING) m queryString name value] {
set cgi($name) $value
} else {
set queryString $env(QUERY_STRING)
}
foreach {name value} [split $queryString &=] {
set cgi([DecodeURL $name]) [DecodeURL $value]
}
}
if 0 {
puts {Content-Type: text/html}
puts {}
puts $env(QUERY_STRING)
puts
puts
puts [array get cgi]
}
# mirrorHomePageRepository
# used in sourceDisplayControl and topForContinue
set mirrorHomePageRepository dpi.inpe.br/banon/2000/01.23.20.24 ;# added by GJFB in 2018-05-28 - required in sourceDisplayControl
if {[info exists cgi(choice)] && [info exists cgi(outputformat)]} { ;# added by GJFB in 2021-04-25 to speed up search result display
set choice $cgi(choice)
set outputFormat $cgi(outputformat)
} else {
# Source displayControl.tcl - added by GJFB in 2018-05-28
set enableOutput 0
eval $sourceDisplayControl ;# required for setting choice and outputFormat only
# Source displayControl.tc - end
}
CreateCGIArray ;# used with POST
if 0 {
puts {Content-Type: text/html}
puts {}
puts [array get cgi]
puts --$outputFormat--
}
if ![info exists cgi(query)] {set cgi(query) {}}
set searchInputValue $cgi(query) ;# added by GJFB in 2022-06-13
# path of searchInputValue from MirrorSearch to mirrorHomePage.html:
# URL with the field query
# MirrorSearch (query -> searchInputValue)
# CreateOutput
# LoopOverEntries
# ServeLocalCollection
# GetEntry
# CreateBriefEntry
# Get
# mirror/xxCover.tcl (click '<')
# CreateMirror
# mirrorHomePage.html (uses forceRecentFlag)
if ![info exists cgi(alternatequery)] {set cgi(alternatequery) {}}
if ![info exists cgi(queryfieldtype)] {set cgi(queryfieldtype) {first}}
if ![info exists cgi(targetvalue)] {set cgi(targetvalue) {_blank}} ;# added by GJFB in 2022-02-13
if ![info exists cgi(accent)] {set cgi(accent) no} ;# values are: yes no
array set accentArray {true yes false no yes yes no no {} no}
set cgi(accent) $accentArray($cgi(accent))
# if [info exists cgi(case2)] {set cgi(case) $cgi(case2)}
array set caseArray {true yes false no yes yes no no {} no}
if [info exists cgi(case2)] {set cgi(case) $caseArray($cgi(case2))}
if ![info exists cgi(case)] {set cgi(case) no} ;# values are: yes no
# if ![info exists cgi(choice)] {set cgi(choice) brief} ;# values are: short brief briefTitleAuthor briefTitleAuthorMisc full fullbibtex fullrefer fullBibINPE fullXML
if ![info exists cgi(choice)] {set cgi(choice) $choice} ;# values are: short brief briefTitleAuthor briefTitleAuthorMisc full fullbibtex fullrefer fullBibINPE fullXML - added by GJFB in 2018-05-28 to customize the search result from displayControl.tcl
if ![info exists cgi(returnbutton)] {set cgi(returnbutton) no} ;# values are: yes no
if ![info exists cgi(sort)] {set cgi(sort) {}} ;# values are: key dateplus dateminus
# if ![info exists cgi(outputformat)] {set cgi(outputformat) 1} ;# used with the option briefTitleAuthorMisc - ex: outputformat=e-mailaddress+abstract
if ![info exists cgi(outputformat)] {set cgi(outputformat) $outputFormat} ;# used with the option briefTitleAuthorMisc - ex: outputformat=e-mailaddress+abstract - added by GJFB in 2018-05-28 to customize the search result from displayControl.tcl
if ![info exists cgi(subsetofgroups)] {set cgi(subsetofgroups) {}}
if ![info exists cgi(languagebutton)] {set cgi(languagebutton) $language} ;# values are: en pt-BR
if ![info exists cgi(username)] {set cgi(username) {}}
if ![info exists cgi(session)] {set cgi(session) {}}
if ![info exists cgi(nameformat)] {set cgi(nameformat) {short}} ;# used with the option briefTitleAuthorMisc - ex: nameformat=familynamelast
if ![info exists cgi(nameseparator)] {set cgi(nameseparator) {; }} ;# used with the option briefTitleAuthorMisc - ex: nameseparator=
if ![info exists cgi(imageflag)] {set cgi(imageflag) 0} ;# added by GJFB in 2018-05-28 - don't display the thumbnail (if any) - required when setting choice == CreateBriefTitleAuthorEntry in displayControl.tcl
# linkType used by CreateBriefTitleAuthorEntry (see CreateBriefTitleAuthorEntry)
# ConditionalSet linkType cgi(linktype) 0 ;# values are: 0 1 2 3 4 5 6 7 (see CreateBriefTitleAuthorEntry)
ConditionalSet linkType cgi(linktype) 1 ;# values are: 0 1 2 3 4 5 6 7 (see CreateBriefTitleAuthorEntry) ;# added by GJFB in 2018-05-28 to let use choice == briefTitleAuthorMisc in col/dpi.inpe.br/banon/2000/01.23.20.24/auxdoc/displayControl.tcl
ConditionalSet cssFileURL cgi(cssfileurl) {}
ConditionalSet forceRecentFlag cgi(forcerecentflag) 0 ;# added by GJFB in 2023-06-09
ConditionalSet forceHistoryBackFlag cgi(forcehistorybackflag) 1 ;# added by GJFB in 2023-06-09
set returnButton $cgi(returnbutton) ;# used in LoopOverEntries
if 0 {
# Update @searchExpressionLog
# Waiting for the completion of other search
while {[EnterQueue [pid] search]} {
set x 0; after 100 {set x 1}; vwait x
}
# Waiting for the completion of other search - end
Store cgi(query) $homePath/@searchExpressionLog auto 0 a
LeaveQueue [pid] search
# Update @searchExpressionLog - end
}
if [regexp {fullXML} $cgi(choice)] {
# set header 0 ;# commented by GJFB in 2020-06-17
set header 1 ;# added by GJFB in 2020-06-17
set cgi(continue) yes
# puts {Content-Type: text/xml} ;# commented by GJFB in 2020-06-17
puts {Content-Type: text/html} ;# added by GJFB in 2020-06-17
} else {
set header 1
# puts {Content-Type: text/html; charset=utf-8} ;# doesn't solve the accent problem
puts {Content-Type: text/html}
}
puts {}
# return
# puts [array get cgi]
# puts $cgi(query)
if [string equal {second} $cgi(queryfieldtype)] {
set cgi(query) $cgi(alternatequery)
} else {
ProcessQuery ;# compute cgi(query)
}
# puts $cgi(query)
# puts $env(QUERY_STRING)
# puts $env(REQUEST_URI)
# return
if [info exists cgi(fieldnamelist)] {
source ../$col/$URLibServiceRepository/doc/utilities3.tcl
ConditionalSet cssFileURL cgi(cssfileurl) {}
set searchExpression $cgi(query) ;# ref Journal
set fieldNameList $cgi(fieldnamelist) ;# journal
set accent {yes}
set case {yes}
set siteList {}
set page {no}
set choice2 {briefTitleAuthorMisc}
set linkType {0}
set displayEverything {0}
set test {1}
puts "Field Value List"
puts "
Search expression: $searchExpression Field name: $fieldNameList
"
puts [DisplayMultipleSearch $searchExpression $fieldNameList $accent $case $siteList $page $choice2 $linkType $displayEverything $test]
puts {}
} else {
if [string equal {full} $cgi(choice)] {
source ../$col/$languageRep2/doc/mirror/${language}FieldName.tcl ;# for full format
}
if {$cgi(choice) == "site"} {
set stampName lastupdate
} else {
set stampName metadatalastupdate
}
# Similar to Submit
set passwordError 0 ;# no password error
# puts [info exists cgi(codedpassword1)]
# puts --$cgi(codedpassword1)--
if [info exists cgi(codedpassword1)] {
set password1 $cgi(codedpassword1)
} elseif {[info exists cgi(password1)]} {
set password1 $cgi(password1)
} elseif {[info exists cgi(pid)]} {
# used to search hidden references (see xxUpdateSubmission.html and submit.tcl)
set pid $cgi(pid)
Load ../tmpForAdministratorPassword-$pid password1 binary
file delete ../tmpForAdministratorPassword-$pid
} else {
set password1 {}
}
if {[info exists cgi(username)] && ![string equal {} $cgi(username)]} {
# not a query from the simple form
# puts [list CheckPassword $cgi(username) $password1]
# set flag [Execute $serverAddressWithIP [list CheckPassword $cgi(username) $password1]]
set command [list list CheckPassword $cgi(username) $password1]
set flag [MultipleExecute [list $serverAddressWithIP] $command]
# puts $flag
if {[string equal {} $flag] || $flag && ![string equal {} $password1]} {
# unknown username or wrong password
set passwordError 1
}
}
# Similar to Submit - end
# puts --$password1--
# puts --$passwordError--
# puts $cgi(query)
set maximumNumberOfEntries 10
if ![info exists cgi(continue)] {set cgi(continue) no}
ConditionalSet siteList cgi(sitelist) {}
if [string equal {yes} $cgi(continue)] {
# if {[string equal {yes} $cgi(continue)] || $cgi(choice) == "fullXML"} #
set maximumNumberOfReferences 0 ;# returns all the entries
} else {
# part of the faster mirror search code
# create output with a maximum of 10 + 1 references
# set maximumNumberOfReferences 0 ;# old code
set maximumNumberOfReferences [expr $maximumNumberOfEntries + 1] ;# new code - faster - GetMetadataRepositories doesn't return all the entries
}
# query
if {[info exists cgi(query2)] && ![string equal {} $cgi(query2)]} {
# multiple search
set searchList [list $cgi(query) $cgi(query2)]
set query [list list GetMetadataRepositories $currentRep 3 $searchList $cgi(accent) $cgi(case) 0 $stampName repArray $password1 $cgi(sort) $maximumNumberOfReferences $cgi(subsetofgroups) 1]
} else {
# simple search
set query [list list GetMetadataRepositories $currentRep 3 $cgi(query) $cgi(accent) $cgi(case) 0 $stampName repArray $password1 $cgi(sort) $maximumNumberOfReferences $cgi(subsetofgroups)]
}
# query2String
# values defined in query2String are used in mirrorget.tcl ?
set query2String {query2=$cgi(query)&choice2=$cgi(choice)&accent2=$cgi(accent)&case2=$cgi(case)}
# set xxx [list [pid] $cgi(query) [clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]]
# Store xxx /dados/URLib/tmp/aaa auto 0 a
# puts $query
# puts $query2String
# => query2=$cgi(query)&choice2=$cgi(choice)&accent2=$cgi(accent)&case2=$cgi(case)
# puts $forceHistoryBackFlag
# CREATE SEARCH RESULT
if [catch {CreateOutput \
$language $languageRep1 $languageRep2 $query $query2String Search {} \
0 $maximumNumberOfEntries $cgi(choice) $header \
{^$} 0 {} $cgi(outputformat) \
{#EEEEEE #E3E3E3} $siteList no \
yes $linkType $passwordError \
$cgi(targetvalue) metadatalastupdate \
site $returnButton $cssFileURL \
$cgi(nameformat) $cgi(nameseparator) $searchInputValue $mirrorIdentifier \
$forceRecentFlag $forceHistoryBackFlag} output2] {
global errorInfo; puts "
MirrorSearch (1): $errorInfo
"
# puts --$output2--
# set xxx $output2
# Store xxx /dados/URLib/tmp/aaa auto 0 a
}
if 0 {
# commented by GJFB in 2020-06-17 - now fullXML has header
if [regexp {fullXML} $cgi(choice)] {
puts {
Search Result
}
puts
puts {<?xml version="1.0" encoding="ISO-8859-1"?>} ;# added by GJFB in 2020-06-17
puts {<metadatalist>} ;# added by GJFB in 2020-06-17
regsub -all {<} $output2 {\<} output2 ;# < -> <
regsub -all {>} $output2 {\>} output2 ;# > -> >
# puts [encoding convertfrom $env(ENCODING_SYSTEM) [join $output2 \n]] ;# solves the accent problem
# puts [join $output2 \n]
puts [encoding convertfrom utf-8 [join $output2 \n]] ;# solves the accent problem
puts {</metadatalist>} ;# added by GJFB in 2020-06-17
puts