# Copyright for the Uniform Repository Service (c) 1995 - 2022, # by Gerald Banon. All rights reserved. # Version 2.1 # cgi/displaydoccontent.tcl # ---------------------------------------------------------------------- # DisplayDocContent # Examples: # http://banon-pc2/displaydoccontent.cgi/iconet.com.br/banon/2007/04.29.22.55 # http://banon-pc2/displaydoccontent.cgi/iconet.com.br/banon/2007/04.29.22.55?closebutton=yes # http://gerald/rep/urlib.net/www/2012/12.27.16.41?metadatarepository=urlib.net/www/2012/12.27.16.41.55&ibiurl.backgroundlanguage=pt-BR&requiredsite=gerald&requiredmetadatatimestamp=2014:01.25.14.10.55&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=gerald:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00&choice=brief&displaytype=Gallery # displaytype field value range is: Gallery FileList Resume {Archival Unit|ArchivalUnit} proc DisplayDocContent {} { if [catch { set currentProcedureName DisplayDocContent global env global cgi ;# used in MountHTMLPage global homePath ;# needed in FindLanguage, MultipleSubmit, UpdateContentDescriptionFile and MountHTMLPage global serverAddress ;# used in SetFieldValue global localSite ;# used MountHTMLPage and CreateDirectoryContentList (called in xxDocContent.html) global mirrorHomePageRep ;# defined in FindLanguage (utilities1.tcl) global currentRep ;# set in this procedure - thisRepository global language languageRep1 languageRep2 ;# needed by CreateOutput and MountHTMLPage global translationTable ;# set in this procedure and used in MountHTMLPage global URLibServiceRepository ;# used in MultipleSubmit (called in MultipleExecute2 called in CreateOutput) global queueLengthFlag ;# used in MultipleSubmit (called in MultipleExecute2 called in CreateOutput) global contentDescriptionArray ;# set in CreateInputList set col ../../../../.. set URLibServiceRepository $env(URLIB_SERVICE_REP) source ../$col/$URLibServiceRepository/doc/utilities1.tcl source ../$col/$URLibServiceRepository/doc/cgi/mirrorfind-.tcl source ../$col/$URLibServiceRepository/doc/utilitiesStart.tcl ;# ListIntersection and ListNegatedImplication # 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 { # required when using puts puts {Content-Type: text/html} puts {} } # serverAddress set serverAddress [list $env(SERVER_NAME) $env(URLIB_PORT)] # thisRepository (repository whose content is being displayed) ## relativePathPrefix if {[llength [file split $env(PATH_INFO)]] == 3} { # ibip form regsub -all { } [lrange [file split $env(PATH_INFO)] 1 2] {/} ibi set thisRepository [Execute $serverAddress [list FindRepositoryNameFromIBI $ibi]] set folder {} # set relativePathPrefix ../../../col } else { # repository form regsub -all { } [lrange [file split $env(PATH_INFO)] 1 4] {/} thisRepository # folder regsub -all { } [lrange [file split $env(PATH_INFO)] 5 end] {/} folder # set relativePathPrefix ../../../../../col } # puts --$folder-- # homePath (used in FindLanguage) set homePath $env(DOCUMENT_ROOT) # mirrorRep set mirrorRep $env(LOBIMIREP) # localSite set localSite $env(SERVER_NAME):$env(SERVER_PORT) # dir if [string equal {} $folder] { set dir $homePath/col/$thisRepository/doc } else { set dir $homePath/col/$thisRepository/doc/$folder } # puts --$dir-- if 0 { # commented by GJFB in 2020-01-02 - see REDIRECT below # Security issue # otherwise the archive directory could be created at a wrong place in system file if ![file isdirectory $dir] { puts "DisplayDocContent: $thisRepository is not a repository in the current local collection." return } # Security issue - end } if [info exists env(QUERY_STRING)] { foreach {name value} [split $env(QUERY_STRING) &=] { set cgi([DecodeURL $name]) [DecodeURL $value] } } # puts --[array get cgi]-- if 0 { # commented by GJFB in 2013-09-21 - now one click is counted when opening the body frame (see Get) # Count one click set URParts [file split $thisRepository] set localURLibClientSocketId [StartCommunication $env(SERVER_NAME) $env(URLIB_PORT)] Submit $localURLibClientSocketId [list PostponeOneClickCount $URParts] close $localURLibClientSocketId # Count one click - end } # SET FIELD VALUES # targetfile # ConditionalSet metadataRep cgi(metadatarepository) [Execute $serverAddress [list FindMetadataRep $thisRepository]] ;# commented by GJFB in 2014-05-22 after a change in CreateAbsolutePath # set metadataRep [Execute $serverAddress [list FindMetadataRep $thisRepository]] ;# commented by GJFB in 2014-08-23 - doesn't display the correct mtadata language of id J8LNKB5R7W/3C8MGFP ConditionalSet metadataRep cgi(metadatarepository) [Execute $serverAddress [list FindMetadataRep $thisRepository]] ;# added by GJFB in 2014-08-23 # puts $metadataRep # SetFieldValue $serverAddress $metadataRep-0 {referencetype title targetfile creatorname fullname identifier contents language textlanguage descriptionlevel secondarytype} # SetFieldValue $serverAddress $metadataRep-0 {referencetype title targetfile creatorname fullname identifier contents language textlanguage descriptionlevel secondarytype parameterlist creatorhistory} # SetFieldValue $serverAddress $metadataRep-0 {referencetype title targetfile creatorname fullname identifier contents language textlanguage descriptionlevel secondarytype parameterlist creatorhistory volume} ;# commented by GJFB in 2022-04-14 SetFieldValue $serverAddress $metadataRep-0 {referencetype title targetfile creatorname fullname date identifier contents language textlanguage descriptionlevel secondarytype parameterlist creatorhistory volume} ;# added by GJFB in 2022-04-14 # textlanguage is the language of the metadata ($metadataRep-0) set docPath $homePath/col/$thisRepository/doc # set targetFileExtension [file extension $targetfile] # if [regexp {^(Resume|Archival Unit)$} $referencetype] # ;# commented by GJFB in 2023-03-14 if {[regexp {^(Resume|Archival Unit)$} $referencetype] && [info exists cgi(nonemptyquerystring)]} { ;# added by GJFB in 2023-03-14 - see 2023-03-14 companion update by GJFB in CreateAbsolutePath # display Resume or Archival Unit if [regexp {^Archival Unit$} $referencetype] { ConditionalSet displayType cgi(displaytype) {Archival Unit} ;# added by GJFB in 2022-04-26 - some Archival Unit might contain a file (@archivistWarning.html); to see it the access button appears with the pair displaytype=FileList in the query string SetFieldValue $serverAddress $metadataRep-0 {readpermission} ;# added by GJFB in 2022-11-18 - required when the Archival Unit contains more than one file (see argument readpermission of ComputeAccessRestrictionFlag in xxDocContent.html) } else { set displayType $referencetype } # # elseif {[string equal {Image} $referencetype]} # ;# commented by GJFB in 2020-08-24 } elseif {[string equal {Image} $referencetype] && ![string equal {} $targetfile]} { ;# added by GJFB in 2020-08-24 # display Gallery # SetFieldValue $serverAddress $metadataRep-0 {readpermission} ;# added by GJFB in 2021-03-03 - required to display the zip download option SetFieldValue $serverAddress $metadataRep-0 {readpermission lastupdate} ;# added by GJFB in 2021-03-03 - required to display the zip download option - added by GJFB in 2021-07-16 - required to preserve any comma (,) in file name ConditionalSet displayType cgi(displaytype) Gallery } else { # display FileList SetFieldValue $serverAddress $metadataRep-0 {readpermission} set displayType FileList } # puts $displayType # if [info exists cgi(displaytype)] # # set displayType $cgi(displaytype) if [string equal {FileList} $displayType] { # Find the language and the language repository foreach {language3 languageRep1 languageRep2} [FindLanguage $mirrorRep] {break} # Find the language and the language repository - end # puts $mirrorRep # puts $language3 # without languagebutton, language3 == env(LANGUAGE_PREFERENCE) # languageRep if ![file isdirectory $homePath/col/$thisRepository] { ;# added by GJFB in 2020-01-02 # thisRepository doesn't exist # REDIRECT - a warning message will be displayed puts "Location: http://$localSite/$thisRepository?ibiurl.backgroundlanguage=$language3" puts "" return } if [file exists $homePath/col/$languageRep1/doc/${language3}DocContent.html] { set languageRep $languageRep1 } else { set languageRep $languageRep2 ;# default } } else { # not FileList # set mirrorHomePageRep dpi.inpe.br/banon/2000/01.23.20.24 set textLanguage $textlanguage ;# textLanguage is used to display "Automatically generated by URLibService" in the text language (language of the metadata) # puts --$textLanguage-- # puts --$language-- if [regexp {fr} $textLanguage] { ;# metadata language # fr set language2 fr ;# needed by CreateOutput } elseif {[regexp {pt} $textLanguage]} { ;# metadata language # pt set language2 pt-BR ;# needed by CreateOutput } elseif {[regexp {en} $textLanguage]} { ;# metadata language # en set language2 en ;# needed by CreateOutput } elseif {[regexp {fr} $language]} { ;# data language # fr set language2 fr ;# needed by CreateOutput } elseif {[regexp {pt} $language]} { ;# data language # pt set language2 pt-BR ;# needed by CreateOutput } elseif {[regexp {en} $language]} { ;# data language # en set language2 en ;# needed by CreateOutput } else { # no data language and no metadata language # Find the language and the language repository foreach {language2 languageRep1 languageRep2} [FindLanguage $mirrorRep] {break} # Find the language and the language repository - end # puts --$language2-- # puts --$languageRep1-- # puts --$languageRep2-- # languageRep if [file exists $homePath/col/$languageRep1/doc/${language2}DocContent.html] { set languageRep $languageRep1 } else { set languageRep $languageRep2 ;# default } } # puts $language2 if [regexp {fr|pt-BR} $language2] { # fr or pt-BR set language3 pt-BR set languageRep dpi.inpe.br/banon/1999/06.19.22.43 ;# needed by xxDocContent.html set languageRep1 dpi.inpe.br/banon/1999/06.19.22.43 ;# needed by CreateOutput set languageRep2 dpi.inpe.br/banon/1999/06.19.22.43 ;# needed by CreateOutput } else { # en set language3 en set languageRep dpi.inpe.br/banon/1999/05.03.22.11 ;# needed by xxDocContent.html set languageRep1 dpi.inpe.br/banon/1999/05.03.22.11 ;# needed by CreateOutput set languageRep2 dpi.inpe.br/banon/1999/05.03.22.11 ;# needed by CreateOutput } set mirrorHomePageRep dpi.inpe.br/banon/2000/01.23.20.24 } puts {Content-Type: text/html} puts {} # puts --$language3-- # puts --$languageRep-- set language $language3 ;# language is a global variable ConditionalSet updateBodyFlag cgi(updatebodyflag) 0 ;# default is don't update - up to now, this flag is not used # ConditionalSet displayType cgi(displaytype) {FileList} # puts $displayType # puts [array get cgi] switch -regexp -- $displayType { Gallery { # gallery components (.png, .gif, .js and .css) were copied from: # http://www.php4script.com/demo/php-photo-album-script/skins/ad_gallery/azcms/skins/ad_gallery # currentRep set currentRep $thisRepository # contentDescriptionArray set targetDirName [file dirname $targetfile] ;# added by GJFB in 2020-03-25 to work with images in directories # if [file exists $docPath/contentDescription.tcl] # if [file exists $docPath/$targetDirName/contentDescription.tcl] { ;# added by GJFB in 2020-03-25 to work with images in directories set inputList [CreateInputList $docPath $targetDirName $lastupdate] # puts $inputList # set startIndex [lsearch $inputList *,$targetfile] # set startIndex [lsearch $inputList *,[file tail $targetfile]] ;# added by GJFB in 2020-03-25 to work with images in directories set startIndex [lsearch $inputList [file tail $targetfile]] ;# added by GJFB in 2020-07-29 - new image ranking facility } else { if 0 { # commented by GJFB in 2020-07-09 set inputList {} set startIndex 0 } elseif 0 { # commented by GJFB in 2020-07-10 # Create inputList # added by GJFB in 2020-07-09 - required after submission and before any update set pwd [pwd] cd $docPath/$targetDirName set inputList {} set inputList [concat $inputList [glob -nocomplain {*.[bB][mM][pP]}]] set inputList [concat $inputList [glob -nocomplain {*.[jJ][pP][gG]}]] cd $pwd # Create inputList - end set startIndex [lsearch $inputList [file tail $targetfile]] ;# added by GJFB in 2020-03-25 to work with images in directories } else { # added by GJFB in 2020-07-10 - useful after submission and before any update # Update contentDescription.tcl UpdateContentDescriptionFile $currentRep $targetfile # Update contentDescription.tcl - end set inputList [CreateInputList $docPath $targetDirName $lastupdate] # set startIndex [lsearch $inputList *,[file tail $targetfile]] set startIndex [lsearch $inputList [file tail $targetfile]] ;# added by GJFB in 2020-07-29 - new image ranking facility } } if [regexp {fr} $language2] { # fr set {translationTable(Gallery deposited in:)} {Galerie déposée en:} set {translationTable(Start)} {Marche} set {translationTable(Stop)} {Arret} } elseif {[regexp {pt} $language2]} { # pt set {translationTable(Gallery deposited in:)} {Galeria depositada em:} set {translationTable(Start)} {Ligar} set {translationTable(Stop)} {Desligar} } else { # en set {translationTable(Gallery deposited in:)} {Gallery deposited in:} set {translationTable(Start)} {Start} set {translationTable(Stop)} {Stop} } puts " Gallery
[EscapeUntrustedData $title]

$translationTable(Gallery deposited in:)
$currentRep

    [ set itemList {} foreach input $inputList { if [regexp {2020:0[89]|2020:1|202[^0]:} $lastupdate] { ;# if added by GJFB in 2021-07-16 - required to preserve any comma (,) in file name after 2020-08-01 (approximation of 2020-07-29) set imageName $input } else { regsub {.*?,} $input {} imageName ;# input old format (ex: zzz,2.jpg) } ConditionalSet alt contentDescriptionArray($input) {} set convertToUTF8 [expr [string equal {utf-8} $env(ENCODING_SYSTEM)] && ![file exists $homePath/col/$currentRep/doc/$imageName]] ;# solves the accent problem when image file names are coded differently (iso and utf) in the same directory (in consequence of a migration between different operating systems (iso and utf)) - added by GJFB in 2013-09-01 - with the new operating system of md-m09.sid.inpe.br, inputList was created (in UpdateRepMetadataRep) with utf-8 as given by $env(ENCODING_SYSTEM) and the current encoding system is iso8859-1 (because of the apache configuration: AddDefaultCharset ISO-8859-1) lappend itemList "
  • \"[encoding
    • " } join $itemList ]
" return } FileList { # currentRep set currentRep $thisRepository } Resume { set htmlTitle Resume # translationTable if [regexp {pt} $language2] { # pt source $homePath/col/dpi.inpe.br/banon/1999/06.19.22.43/doc/mirror/pt-BRReferenceTypeName.tcl ;# translationTable (reference type) set {translationTable(Automatically generated by URLibService)} {Gerado automaticamente pelo URLibService} set {translationTable(Original document URL:)} {URL do documento original:} set {translationTable(Contents)} {Sumário} set {translationTable(Top)} {Voltar ao topo} set {translationTable(reloading completed)} {recarregamento concluido} } else { # en source $homePath/col/dpi.inpe.br/banon/1999/05.03.22.11/doc/mirror/enReferenceTypeName.tcl ;# translationTable (reference type) set {translationTable(Automatically generated by URLibService)} {Automatically generated by URLibService} set {translationTable(Original document URL:)} {Original document URL:} set {translationTable(Contents)} {Contents} set {translationTable(Top)} {Return to top} set {translationTable(reloading completed)} {reloading completed} } if [string equal {} $contents] { set referenceTypeList {{Journal Article} {Conference Proceedings} {Book Section} {Book} {Edited Book} {Report} {Electronic Source} {Audiovisual Material}} } else { regsub {\.$} $contents {} contents ;# drop full stop set referenceTypeList [split $contents {;}] } # contentsListForArray set contentsListForArray {} foreach referenceType $referenceTypeList { set referenceType [string trim $referenceType] set referenceType2 $translationTable($referenceType) set searchExpression "resumeid, $identifier and referencetype, $referenceType," lappend contentsListForArray $searchExpression $referenceType2 } set translatedTitle $title regsub {(.*),\s*(.*),} [join $fullname] {\2 \1} creator set updateNextHigherUnitFlag 0 # MountHTMLPage $thisRepository $htmlTitle $translatedTitle $descriptionlevel $creator $identifier $mirrorRep $contentsListForArray $updateNextHigherUnitFlag $secondarytype $updateBodyFlag # MountHTMLPage $thisRepository $htmlTitle $translatedTitle $descriptionlevel $creator $identifier $mirrorRep $contentsListForArray $updateNextHigherUnitFlag $secondarytype $parameterlist $updateBodyFlag ;# commented by GJFB in 2022-04-14 MountHTMLPage $thisRepository $htmlTitle $translatedTitle $descriptionlevel $creator $date $identifier $mirrorRep $contentsListForArray $updateNextHigherUnitFlag $secondarytype $parameterlist $updateBodyFlag ;# added by GJFB in 2022-04-14 return } {Archival Unit|ArchivalUnit} { set htmlTitle {Archival Unit} # translationTable if [regexp {pt|fr} $language2] { # pt set {translationTable(Automatically generated by URLibService)} {Gerado automaticamente pelo URLibService} set {translationTable(Frozen content)} {Conteúdo congelado} set {translationTable(Original document URL:)} {URL do documento original:} set {translationTable(Contents)} {Sumário} set {translationTable(Top)} {Voltar ao topo} set {translationTable(reloading completed)} {recarregamento concluido} } else { # en set {translationTable(Automatically generated by URLibService)} {Automatically generated by URLibService} set {translationTable(Frozen content)} {Frozen content} set {translationTable(Original document URL:)} {Original document URL:} set {translationTable(Contents)} {Contents} set {translationTable(Top)} {Return to top} set {translationTable(reloading completed)} {reloading completed} } # contentsListForArray set contentsListForArray $contents set title [regsub -all {URLib} $title {URLib}] ;# added by GJFB in 2021-09-30 set translatedTitle $title set creator [FormatAuthorList [FormatAuthorName $creatorname] {;} 0 0 {&} 3] set updateNextHigherUnitFlag 1 # MountHTMLPage $thisRepository $htmlTitle $translatedTitle $descriptionlevel $creator $identifier $mirrorRep $contentsListForArray $updateNextHigherUnitFlag $secondarytype $updateBodyFlag # MountHTMLPage $thisRepository $htmlTitle $translatedTitle $descriptionlevel $creator $identifier $mirrorRep $contentsListForArray $updateNextHigherUnitFlag $secondarytype $parameterlist $updateBodyFlag $creatorhistory # puts $updateBodyFlag # MountHTMLPage $thisRepository $htmlTitle $translatedTitle $descriptionlevel $creator $identifier $mirrorRep $contentsListForArray $updateNextHigherUnitFlag $secondarytype $parameterlist $updateBodyFlag $creatorhistory $volume ;# commented by GJFB in 2022-04-14 MountHTMLPage $thisRepository $htmlTitle $translatedTitle $descriptionlevel $creator $date $identifier $mirrorRep $contentsListForArray $updateNextHigherUnitFlag $secondarytype $parameterlist $updateBodyFlag $creatorhistory $volume ;# added by GJFB in 2022-04-14 return } } # continuation of FileList Load $homePath/col/$languageRep/doc/${language}DocContent.html fileContent ;# needs displayType and calls CreateDirectoryContentList # puts $homePath/col/$languageRep/doc/${language}DocContent.html puts [subst $fileContent] } m] { if ![string equal {} $m] { puts {Content-Type: text/html} puts {} puts 
		puts $m
		if 0 {global errorInfo; puts $errorInfo}
		puts
} } } # DisplayDocContent - end # ---------------------------------------------------------------------- # CreateInputList proc CreateInputList {docPath targetDirName lastupdate} { global contentDescriptionArray interp create -safe slave interp expose slave source # set contentDescriptionList [interp eval slave [list source $docPath/contentDescription.tcl]] ;# set contentDescriptionList set contentDescriptionList [interp eval slave [list source $docPath/$targetDirName/contentDescription.tcl]] ;# set contentDescriptionList - added by GJFB in 2020-03-25 to work with images in directories array set contentDescriptionArray $contentDescriptionList ;# commented by GJFB in 2020-07-29 # return [encoding convertfrom utf-8 [lsort -dictionary [array names contentDescriptionArray]]] ;# solves the accent problem in md-m09 - added by GJFB in 2013-08-31 - commented by GJFB in 2020-07-29 set imageList2 {} foreach {imageName2 imageLegend} $contentDescriptionList { # lastup 2020:0[89]* or lastup 2020:1* or lastup 2021:* if ![regexp {2020:0[89]|2020:1|202[^0]:} $lastupdate] { ;# if added by GJFB in 2021-07-16 - required to preserve any comma (,) in file name after 2020-08-01 (approximation of 2020-07-29) # imageName2 old format (ex: zzz,2.jpg) regsub {.*?,} $imageName2 {} imageName2 ;# remove initial string - migration to the new image ranking facility } lappend imageList2 $imageName2 } return [encoding convertfrom utf-8 $imageList2] ;# solves the accent problem in md-m09 - added by GJFB in 2020-07-29 - new image ranking facility } # CreateInputList - end # ---------------------------------------------------------------------- # MountHTMLPage # updateNextHigherUnitFlag value is 0 or 1 # 1 means to update nexthigherunit # parameterlist value example: sort shorttitle (used in id 8JMKD3MGPCW/3EQCC85) # called by DisplayDocContent only proc MountHTMLPage { thisRepository htmlTitle translatedTitle descriptionlevel creator date identifier mirrorRep contentsListForArray updateNextHigherUnitFlag secondaryType parameterlist updateBodyFlag {creatorhistory {}} {volume {}} } { global env global cgi ;# set in DisplayDocContent global homePath ;# set in DisplayDocContent global localSite ;# set in DisplayDocContent global mirrorHomePageRep ;# defined in FindLanguage (utilities1.tcl) global language languageRep1 languageRep2 ;# set in DisplayDocContent global translationTable ;# set in DisplayDocContent global currentRep ;# set in this procedure - mirrorRep; needed in DisplaySearch global multipleLineReferFieldNamePattern ;# used by GetReferField (called by CreateVersionStamp) # ConditionalSet run cgi(run) 0 ;# slow loading (the page is displayed only after completion of all searches) set run 1 ;# faster - uses progressive loading if !$run { # slow loading - not used # code found in: http://www.electrictoolbox.com/load-content-jquery-ajax-loading-image/ puts " $htmlTitle
" } else { # progressive loading # Change default configuration and add new parameter # example of new parameter name: frozencontent (value is yes or no (default)) # added by GJFB in 2020-10-02 # same code in UpdateBody if ![string equal {} $parameterlist] { array set configurationArray $parameterlist foreach name [array names configurationArray] { set $name $configurationArray($name) ;# example set accent no - change the default value which is yes } } # Change default configuration and add new parameter - end # Compute the update flag # updating the body page and the nexthigherunit fields is time consuming and should be done only once a day if $updateBodyFlag { set updateFlag 1 ;# update } else { if 0 { # commented by GJFB in 2023-01-14 if [file exists $homePath/col/$thisRepository/auxdoc/body.html] { # see similar code in TestForTclPageUpdate set startingSecond [clock scan 02:00:00 -base 109306800] # set timePeriod 1 ;# 1 seconds set timePeriod [expr 24*60*60] ;# 1 day set mtime [file mtime $homePath/col/$thisRepository/auxdoc/body.html] set seconds [clock seconds] # updateFlag if {[expr ($seconds - $startingSecond)/$timePeriod] != [expr ($mtime - $startingSecond)/$timePeriod]} { # old body page file - update the body page file # let the transition times be = {starting second + n * time period: n = 0, 1, ...} # since the last update (mtime) at least one transition time occured set updateFlag 1 ;# update # Update mtime # avoid two successive updates if [catch {file mtime $homePath/col/$thisRepository/auxdoc/body.html [clock seconds]} m] { # puts "mtime not updated for $homePath/col/$thisRepository/auxdoc/body.html" } # Update mtime - end } else { set updateFlag 0 ;# don't update } } else { set updateFlag 1 ;# update } } else { # added by GJFB in 2023-01-14 to use the new procedure ComputeFileUpdateFlag # set timePeriod 1 ;# 1 seconds set timePeriod [expr 24*60*60] ;# 1 day set filePath $homePath/col/$thisRepository/auxdoc/body.html set updateFlag [ComputeFileUpdateFlag $filePath $timePeriod] if $updateFlag { # Update mtime # avoid two successive updates if [catch {file mtime $filePath [clock seconds]} m] { # puts "mtime not updated for $filePath or $filePath doesn't exist" } } } } # puts >>>$updateFlag # Compute the update flag - end Load $homePath/col/$thisRepository/auxdoc/${language}Contents.html tableOfContents2 ;# table of contents created at the previous display set output " $htmlTitle [ if {[info exists creatorhistory] && ![string equal {} $creatorhistory]} { set x " " } ] [ set archivistWarningFileName $homePath/col/$thisRepository/doc/@archivistWarning.html if [file exists $archivistWarningFileName] { Load $archivistWarningFileName fileContent set x " " } ] $tableOfContents2
     
 
$translationTable(Automatically generated by URLibService) [ if {[info exists frozencontent] && [string equal {yes} $frozencontent]} { set x "
: $translationTable(Frozen content) :" } ]


[expr [string equal {} $volume]?{}:{Volume $volume

}] $translatedTitle

[ if [info exists descriptionlevel] { set x "

$descriptionlevel

" } ]

$creator

$date

[ if {[info exists creatorhistory] && ![string equal {} $creatorhistory]} { set x "

$creatorhistory

" } ]

[ if [regexp {\.} $env(SERVER_NAME)] { set x " $translationTable(Original document URL:)
<\;http://urlib.net/ibi/$identifier>\; " } else { set x " IBI: $identifier " } ]


 
  $fileContent  
 
" # puts [string length $output] puts $output if $updateFlag {set output3 $output} ;# (1 - begin) added by GJFB in 2023-03-13 # flush stdout ;# no change observed in Windows - progressive loading continues not working # fconfigure stdout -blocking 0 ;# no change observed in Windows - progressive loading continues not working # fconfigure stdout -buffering none ;# no change observed in Windows - progressive loading continues not working # fconfigure stdout -buffersize 32 ;# no change observed in Windows - progressive loading continues not working # puts [fconfigure stdout] set output "" ;# to have the header loaded at once puts $output if $updateFlag {append output3 $output} ;# (2) added by GJFB in 2023-03-13 # currentRep set currentRep $mirrorRep ;# needed in ComputeFieldValueList and DisplaySearch set accent {yes} ;# default set case {yes} ;# default if [string equal {} $contentsListForArray] { set tableOfContents {} Store tableOfContents $homePath/col/$thisRepository/auxdoc/${language}Contents.html puts " " return } set siteList [ComputeSiteList $thisRepository] ;# if $thisRepository is not a mirror repository and col/$thisRepository/doc/@siteList.txt doesn´t exist then col/$env(LOBIMIREP)/doc/@siteList.txt is used instead # puts $siteList foreach {searchExpression fieldName} $contentsListForArray {break} # puts $searchExpression # puts --$fieldName-- # puts [CallTrace] if {[lsearch {theme} $fieldName] != -1} { # compute new contentsListForArray set contentsListForArray {} # puts "ComputeFieldValueList $searchExpression $fieldName $accent $case $siteList" # => ComputeFieldValueList col Voyage France theme yes yes {gjfb 19050} set fieldValueList [ComputeFieldValueList $searchExpression $fieldName $accent $case $siteList] # puts --$fieldValueList-- # => --Albi Carcassonne Lourdes {Maison de vovó Michelle} Montauban Paris Toulouse-- foreach fieldValue $fieldValueList { regsub -all { and } $fieldValue { } fieldValue2 lappend contentsListForArray "$searchExpression and theme $fieldValue2" $fieldValue } # puts --$contentsListForArray-- # => --{col Voyage France and theme Albi} Albi {col Voyage France and theme Carcassonne} Carcassonne {col Voyage France and theme Lourdes} Lourdes {col Voyage France and theme Maison de vovó Michelle} {Maison de vovó Michelle} {col Voyage France and theme Montauban} Montauban {col Voyage France and theme Paris} Paris {col Voyage France and theme Toulouse} Toulouse-- } ConditionalSet searchInputValue cgi(searchinputvalue) {} ;# added by GJFB in 2022-06-13 - useful when linkType == 1 and targetValue is _top set searchInputValue [regsub -all { +} $searchInputValue {+}] ConditionalSet parentIdentifierCitedBy cgi(parentidentifiercitedby) {} ;# added by GJFB in 2023-03-10 - useful when linkType == 1 and targetValue is _top set childIdentifierList [concat $identifier $parentIdentifierCitedBy] ;# added by GJFB in 2023-03-10 - useful when linkType == 1 and targetValue is _top set childIdentifierList [regsub -all { +} $childIdentifierList {+}] ConditionalSet forceRecentFlag cgi(forcerecentflag) 0 ;# added by GJFB in 2022-06-13 - useful when linkType == 1 and targetValue is _top # puts --$contentsListForArray-- if [file exists $homePath/col/$thisRepository/auxdoc/body.html] { Load $homePath/col/$thisRepository/auxdoc/body.html body # puts $body ;# commented by GJFB in 2023-03-21 puts [subst $body] ;# added by GJFB in 2023-03-21 to finish solving the navigation problem between information itens begun in 2022-06-13, especially to solve the case of a list of child identifiers if $updateFlag { # set tableOfContents [UpdateBody $thisRepository $secondaryType $mirrorRep $contentsListForArray $language $tableOfContents2 0] ;# don't display the body - don't use the command puts # set tableOfContents [UpdateBody $thisRepository $secondaryType $mirrorRep $contentsListForArray $language $tableOfContents2 $parameterlist 0] ;# don't display the body - don't use the command puts set tableOfContents [UpdateBody $thisRepository $identifier $secondaryType $mirrorRep $contentsListForArray $language $tableOfContents2 $parameterlist 0] ;# don't display the body - don't use the command puts } } else { # set tableOfContents [UpdateBody $thisRepository $secondaryType $mirrorRep $contentsListForArray $language $tableOfContents2 1] ;# display the body using the command puts # set tableOfContents [UpdateBody $thisRepository $secondaryType $mirrorRep $contentsListForArray $language $tableOfContents2 $parameterlist 1] ;# display the body using the command puts set tableOfContents [UpdateBody $thisRepository $identifier $secondaryType $mirrorRep $contentsListForArray $language $tableOfContents2 $parameterlist 1] ;# display the body using the command puts } if $updateFlag { Load $homePath/col/$thisRepository/auxdoc/body.html body ;# added by GJFB in 2023-03-13 append output3 $body ;# (3) added by GJFB in 2023-03-13 } # set x 0; after 3000 {set x 1}; vwait x ;# for testing progressive loading set output "
- $translationTable(reloading completed) - " puts $output # puts $print ;# set in UpdateBody if $updateFlag {append output3 $output} ;# (4 - end)) added by GJFB in 2023-03-13 if 1 { # added by GJFB in 2023-03-13 to try to solve a Google indexing requirement - seems to have no effect if $updateFlag {Store output3 $homePath/col/$thisRepository/doc/thisArchivalUnit.html auto 0 w 0 iso8859-1} } else { file delete $homePath/col/$thisRepository/doc/thisArchivalUnit.html } if $updateFlag { # update nexthigherunit fields # puts $updateNextHigherUnitFlag # if $updateNextHigherUnitFlag # if {$updateNextHigherUnitFlag && !([info exists frozencontent] && [string equal {yes} $frozencontent])} { # update nexthigherunit # loCoInRep set loCoInRep $env(LOCOINREP) # codedPassword Load $homePath/col/$loCoInRep/auxdoc/xxx data binary set data [UnShift $data] set codedPassword2 [lindex $data end] ;# default codedPassword if [file exists $homePath/col/$loCoInRep/auxdoc/siteStampXcodedPasswordArray.tcl] { # added by GJFB in 2021-02-16 for Federated Archives that have agreed to share administrator passwords to grant them permission to update the nexthigher field of any records source $homePath/col/$loCoInRep/auxdoc/siteStampXcodedPasswordArray.tcl ;# array set siteStampXcodedPasswordArray foreach siteStamp [array names siteStampXcodedPasswordArray] { set site [lindex $siteStamp 0] if ![string equal {} $siteStampXcodedPasswordArray($siteStamp)] { # not an empty coded password # some site stamp, as the one of urlib.net, might be an entry of siteStampXcodedPasswordArray but the coded password is not informed (is empty) # this is neccessary, for example, when building return paths from a bibliographic mirror that have 83LX3pFwXQZeBBx/BbsHa (the urlib.net default bibliographic mirror) as a nexthigherunit # in this case, no coded password is required and the value of {siteStampXcodedPasswordArray({www.urlib.net 800} dpi.inpe.br/banon/2004/02.16.09.29 200.160.7.168)} is empty # but such site stamp must be an entry of siteStampXcodedPasswordArray (see BuildReturnPathArray) set siteXcodedPasswordArray($site) $siteStampXcodedPasswordArray($siteStamp) lappend siteList $site ;# add missing sites of the Federated Archives } } } # multipleLineReferFieldNamePattern set multipleLineReferFieldNamePattern $env(MULI_PATTERN) ;# used by GetReferField (called by CreateVersionStamp) set fieldNameList nexthigherunit set rangeList {{}} ;# don't modifify new value - see ChangeFieldValue # add nexthigherunit set addList {} foreach {searchExpression sectionTitle} $contentsListForArray { regsub -all {(\[|\])} $searchExpression {\\\1} searchExpression ;# added by GJFB in 2021-01-27 - required because of the subst command below - xx [12] yy -> xx \[12\] yy set searchExpression [subst $searchExpression] ;# added by GJFB in 2021-01-27 to solve $thisRepository in search expression containing string like 'and not repository, $thisRepository' - used in expression that could return the proper record set searchExpression "$searchExpression and not nexthigherunit, $identifier" # set searchExpression2 "textlanguage, $language or not textlanguage, * and {$searchExpression}" set searchExpression2 $searchExpression ;# added by GJFB in 2013-08-17 - multiple language metadata must be treated in the same way # puts "FindMetadataRepositories $searchExpression2 0 $siteList $codedPassword2 $accent $case 1" # set addList [concat $addList [FindMetadataRepositories $searchExpression2 0 $siteList $codedPassword2 $accent $case 1]] ;# commented by GJFB in 2021-02-14 set addList [concat $addList [FindMetadataRepositories $searchExpression2 0 $siteList {} $accent $case 1]] ;# added by GJFB in 2021-02-14 - just visible record matter - no password required } # remove nexthigherunit set searchExpressionList2 {} foreach {searchExpression sectionTitle} $contentsListForArray { regsub -all {(\[|\])} $searchExpression {\\\1} searchExpression ;# added by GJFB in 2021-01-27 - required because of the subst command below - xx [12] yy -> xx \[12\] yy set searchExpression [subst $searchExpression] ;# added by GJFB in 2021-01-27 to solve $thisRepository in search expression containing string like 'and not repository, $thisRepository' - used in expression that could return the proper record # set searchExpression2 "textlanguage, $language or not textlanguage, * and {$searchExpression}" set searchExpression2 $searchExpression ;# added by GJFB in 2013-08-17 - multiple language metadata must be treated in the same way lappend searchExpressionList2 "not {$searchExpression2}" } if [string equal {} $searchExpressionList2] { set searchExpression "nexthigherunit, $identifier" } else { set searchExpression "nexthigherunit, $identifier and [join $searchExpressionList2 { and }]" } # puts 2-$searchExpression # puts [FindMetadataRepositories $searchExpression 0 {} $codedPassword2 $accent $case 1] # set removeList [FindMetadataRepositories $searchExpression 0 $siteList $codedPassword2 $accent $case 1] ;# commented by GJFB in 2021-02-14 set removeList [FindMetadataRepositories $searchExpression 0 $siteList {} $accent $case 1] ;# added by GJFB in 2021-02-14 - just visible record matter - no password required # puts "addList length = [llength $addList]" # puts "removeList length = [llength $removeList]" set totalOfChanges [expr [llength $addList] + [llength $removeList]] # puts $totalOfChanges Store totalOfChanges $homePath/col/$thisRepository/auxdoc/@progress.txt # set i 0 set changesLeft $totalOfChanges # puts >>>>>$addList ;# see output at the bottom of the source page # => {{gjfb 19050} iconet.com.br/banon/2009/09.09.22.01.52-0} {{gjfb 19050} sid.inpe.br/mtc-m16c/2016/01.15.15.47.47-0} {{gjfb 19050} sid.inpe.br/mtc-m18/2015/08.01.02.06.44-0} # add nexthigherunit foreach element $addList { foreach {site rep-i} $element {break} SetFieldValue $site ${rep-i} {repository metadatarepository metadatalastupdate nexthigherunit} # puts "\[Execute $site \[list GetDocumentState $repository\]\] = [Execute $site [list GetDocumentState $repository]]" # similar code in Get if [Execute $site [list GetDocumentState $repository]] { # the document is the original if [info exists siteXcodedPasswordArray($site)] { # added by GJFB in 2021-02-16 for Federated Archives that have agreed to share administrator passwords to grant them permission to update the nexthigher field of any records set codedPassword $siteXcodedPasswordArray($site) } else { set codedPassword $codedPassword2 ;# default codedPassword - administrator codedPassword of the site that mounts the HTML page } set command [list list CheckPassword administrator $codedPassword] ;# codedPassword should be the same for all sites set flag [MultipleExecute [list $site] $command] # puts "$site $codedPassword $repository - flag = $flag" if {[string equal {} $flag] || $flag} {continue} ;# wrong password Execute $site [list WaitQueue2 DisplayDocContent {} $codedPassword] 0 ;# not async set metadataList {} ;# for add set metadata2List {} ;# for remove set repositoryList {} # set fieldNameList nexthigherunit set oldFieldValueList [list $nexthigherunit] set newFieldValueList [list [lsort -unique [concat $nexthigherunit $identifier]]] set userName administrator ChangeFieldValue $site $metadatarepository $metadatalastupdate $fieldNameList $oldFieldValueList $newFieldValueList $rangeList $userName $codedPassword ;# changes metadataList and metadata2List lappend repositoryList $repository $metadatarepository if 0 { # commented by GJFB in 2020-08-18 Execute $site [list RemoveMetadata $metadata2List] Execute $site [list AddMetadata $metadataList] } else { Execute $site [list UpdateMetadata $metadata2List $metadataList] ;# added by GJFB in 2020-08-18 - uses metadata2List and metadataList } Execute $site [list UpdateRepositoryListForPost $repositoryList] Execute $site [list LeaveQueue] 0 ;# not async # incr i incr changesLeft -1 # puts $changesLeft Store changesLeft $homePath/col/$thisRepository/auxdoc/@progress.txt } } # remove nexthigherunit foreach element $removeList { foreach {site rep-i} $element {break} SetFieldValue $site ${rep-i} {repository metadatarepository metadatalastupdate nexthigherunit} # similar code in Get if [Execute $site [list GetDocumentState $repository]] { # the document is the original if [info exists siteXcodedPasswordArray($site)] { # added by GJFB in 2021-02-16 for Federated Archives that have agreed to share administrator passwords to grant them permission to update the nexthigher field of any records set codedPassword $siteXcodedPasswordArray($site) } else { set codedPassword $codedPassword2 ;# default codedPassword - administrator codedPassword of the site that mounts the HTML page } set command [list list CheckPassword administrator $codedPassword] ;# codedPassword should be the same for all sites set flag [MultipleExecute [list $site] $command] if {[string equal {} $flag] || $flag} {continue} ;# wrong password Execute $site [list WaitQueue2 DisplayDocContent {} $codedPassword] 0 ;# not async set metadataList {} ;# for add set metadata2List {} ;# for remove set repositoryList {} # set fieldNameList nexthigherunit set oldFieldValueList [list $nexthigherunit] set index [lsearch $nexthigherunit $identifier] set newNextHigherUnit [lreplace $nexthigherunit $index $index] set newFieldValueList [list $newNextHigherUnit] set userName administrator ChangeFieldValue $site $metadatarepository $metadatalastupdate $fieldNameList $oldFieldValueList $newFieldValueList $rangeList $userName $codedPassword ;# changes metadataList and metadata2List lappend repositoryList $repository $metadatarepository if 0 { # commented by GJFB in 2020-08-18 Execute $site [list RemoveMetadata $metadata2List] Execute $site [list AddMetadata $metadataList] } else { Execute $site [list UpdateMetadata $metadata2List $metadataList] ;# added by GJFB in 2020-08-18 - uses metadata2List and metadataList } Execute $site [list UpdateRepositoryListForPost $repositoryList] Execute $site [list LeaveQueue] 0 ;# not async # incr i incr changesLeft -1 Store changesLeft $homePath/col/$thisRepository/auxdoc/@progress.txt } } } else { # don't update nexthigherunit } # puts " # # " } # puts " # # # " } ;# progressive loading - end } # MountHTMLPage - end # ---------------------------------------------------------------------- # UpdateBody # called in MountHTMLPage only ## parameterlist value is empty or sort date.year.key # parameterlist value is a list with no element or with one or more of the following elements like: # sort date.year.key # accent no # case no # frozencontent yes # the values of theses first three pairs are intended to change the default values set below proc UpdateBody { thisRepository identifier secondaryType mirrorRep contentsListForArray language tableOfContents2 parameterlist displayBodyFlag } { global homePath global translationTable ;# set in DisplayDocContent # upvar print print # set print $cgi(parentidentifiercitedby) ;# see '# puts $print' is in MountHTMLPage # linType values are 0, 1, ..., 9 # # 0 is for absolute link with col (default) # 1 is for absolute link with rep # 2 is for absolute link with rep- # 3 is for relative link with ../../../../.. # 4 is for relative link with ../../../../../../col # 5 is for relative link with goto # 6 is for relative link with goto- # 7 is for no link # 8 is for absolute link http://urlib.net/ # 9 is for absolute link http://urlib.net/rep/ # set searchExpression "resumeid, $identifier" # --------------------------------------------------- set accent {yes} set case {yes} set choice {briefTitleAuthorMisc} set title {($numberOfEntries)
} set excludedFields {} set localSearch {0} set numbering {} # set siteList [ComputeSiteList] set siteList [ComputeSiteList $thisRepository] ;# if $thisRepository is not a mirror repository and col/$thisRepository/doc/@siteList.txt doesn´t exist then col/$env(LOBIMIREP)/doc/@siteList.txt is used instead set page {no} set linkType {1} set displayEverything {1} set sort {year.key.title} ;# default set outputFormat {year-cite} ;# default # set targetValue {_blank} ;# commented by GJFB in 2013-06-18 # set targetValue {_parent} ;# added by GJFB in 2013-06-18 in order to navigate from the same window set targetValue {_top} ;# added by GJFB in 2013-06-18 in order to navigate from the same window # set mirrorRep {} set nameFormat {short} set nameSeparator {; } ;# default set latexOptionList {} set multipleSearch {0} set imageFlag [string equal {image} $secondaryType] if 0 { # commented by GJFB in 2023-03-21 set searchInputValue {} set childIdentifierList $identifier # lappend print $childIdentifierList set forceRecentFlag 1 } else { # added by GJFB in 2023-03-21 set searchInputValue {\$searchInputValue} set childIdentifierList {\$childIdentifierList} set forceRecentFlag {\$forceRecentFlag} } # Change default configuration and add new parameter # example of new parameter name: frozencontent (value is yes or no (default)) # added by GJFB in 2016-03-14 if ![string equal {} $parameterlist] { array set configurationArray $parameterlist foreach name [array names configurationArray] { set $name $configurationArray($name) ;# example set sort date.year.key - change the default value which is year.key.title } } # Change default configuration and add new parameter - end if $imageFlag { # set outputFormat {place date lineage} ;# commented by GJFB in 2021-08-05 set outputFormat {place date} ;# added by GJFB in 2021-08-05 to avoid the display of too much tecnical information set nameSeparator {
} } source ../../doc/utilities3.tcl ;# DisplaySearch # currentRep set currentRep $mirrorRep ;# needed in DisplaySearch set i 0 set tableOfContents {} ;# new table of contents # FOREACH set output {} ;# used for progressive loading set output2 {} ;# used to create auxdoc/body.html foreach {searchExpression sectionTitle} $contentsListForArray { regsub -all {(\[|\])} $searchExpression {\\\1} searchExpression ;# added by GJFB in 2021-01-27 - required because of the subst command below - xx [12] yy -> xx \[12\] yy set searchExpression [subst $searchExpression] ;# added by GJFB in 2021-01-27 to solve $thisRepository in search expression containing string like 'and not repository, $thisRepository' - used in expression that could return the proper record # set x 0; after 2000 {set x 1}; vwait x ;# for testing progressive loading # puts $searchExpression ;# the output is at the bottom of the web page # puts --$sort-- ;# the output is at the bottom of the web page set searchExpression2 "textlanguage, $language or not textlanguage, * and {$searchExpression}" # puts $searchExpression2 ;# the output is at the bottom of the web page # puts $siteList ;# the output is at the bottom of the web page if {[info exists frozencontent] && [string equal {yes} $frozencontent]} { set searchExpression2 "nexthigherunit $identifier and {$searchExpression2}" ;# added by GJFB in 2021-03-01 to freeze the Archival Unit content, that is no more search itens should be added } # puts $searchExpression2 ;# the output is at the bottom of the web page # DISPLAYSEARCH set result [ \ DisplaySearch \ $searchExpression2 $accent $case \ $choice $title $excludedFields \ $localSearch $numbering $siteList \ $page $linkType $displayEverything \ $sort $outputFormat $targetValue \ $mirrorRep $nameFormat $nameSeparator \ $latexOptionList $multipleSearch $imageFlag \ 0 $searchInputValue \ $childIdentifierList $forceRecentFlag \ ] if ![string equal {} $result] { incr i if [string equal {} $tableOfContents2] { # puts "
$sectionTitle" lappend output "
$sectionTitle" lappend output2 "
$sectionTitle" } else { # puts "
$i. $sectionTitle" lappend output "
$i. $sectionTitle" lappend output2 "
$i. $sectionTitle" } # puts $result lappend output $result lappend output2 $result # puts "" ;# to have the section displayed at once lappend output "" ;# to have the section displayed at once lappend output2 "" ;# to have the section displayed at once if $displayBodyFlag { puts [join $output \n] set output {} } lappend tableOfContents "

$i. $sectionTitle

" } } set footer "
 
 
 
     
" lappend output $footer lappend output2 $footer # puts "" ;# to have the horizontal rule displayed at once lappend output "" ;# to have the horizontal rule displayed at once lappend output2 "" ;# to have the horizontal rule displayed at once if $displayBodyFlag { puts [join $output \n] set output {} } if {[llength $tableOfContents] > 1} { set tableOfContents "  

$translationTable(Contents)

[join $tableOfContents \n]
  " Store tableOfContents $homePath/col/$thisRepository/auxdoc/${language}Contents.html } else { file delete $homePath/col/$thisRepository/auxdoc/${language}Contents.html } set body [join $output2 \n] Store body $homePath/col/$thisRepository/auxdoc/body.html return $tableOfContents } # UpdateBody - end # ----------------------------------------------------------------------