#!/usr/bin/tclsh # maybe change upper line for NEXTSTEP # FM 24.12.2001 / March 2008 # This cgi script does the searching for all plants according # to given criteria (using "pflanzen.lst" database and awk) # It outputs the final list in html format, including links to # the html files (where appropriate). The list is sorted # in alphabetical order, using sort, either with reference to # german or latin names # this version without sort or awk! # TAKE SECOND LINE FOR ONLINE VERSION: set CGIBIN /cgi-bin/pflanze.pl set PROFISUCHE /pflanzensuche.html set EASYSUCHE /sucheeinfach.html set ALPHABETSUCHE /alphabetliste.html set INFIN 1000000 #NEW THE DATABASEFILE (in cgi-bin): set DATABASEFILE pflanzen.lst #old stuff: #set DATABASE /part2/autopflanz/pflanzen.lst #set DATABASE /NextLibrary/WebServer/data/pflanzen.lst #puts "Content-Type: text/html\n\n" #puts { # #Hallo es geht # #} #exit #NEW READ IN DATABASE #puts [file exists $DATABASEFILE] #exit set datafile [open $DATABASEFILE] set database0 [read $datafile] close $datafile #puts $database0 #puts {} #exit # replace empty numerical fields by 0: proc zero {li n} { if [string match "" [lindex $li $n]] { return [lreplace $li $n $n 0] } set number [expr [lindex $li $n]] return $li } set database1 [split $database0 "\n"] set database2 "" # split up individual lines and # insert zeroes where the number value is missing # in number fields: set j 0 foreach line $database1 { incr j set line [split $line ","] if [llength $line]<14 {puts "SHORT at $j: $line "} set line [zero $line 4] set line [zero $line 5] set line [zero $line 6] set line [zero $line 7] set line [zero $line 8] lappend database2 $line } #NEW END DATABASE READ IN proc encode {w} { regsub -all { } $w {_} w return $w } proc decode {w} { regsub -all %E4 $w "\\ä" w regsub -all %F6 $w "\\ö" w regsub -all %FC $w "\\ü" w regsub -all %C4 $w "\\Ä" w regsub -all %D6 $w "\\Ö" w regsub -all %DC $w "\\Ü" w regsub -all %DF $w "\\ß" w regsub -all %7C $w "|" w regsub -all {\+} $w " " w return $w } set query $env(QUERY_STRING) if ![regexp {makeframe} $query z] { append query {&makeframe=1} puts {Content-type: text/html Suchresultate } puts "\n" puts { } } { if [regexp {makeframe=1} $query] { regsub {makeframe=1} $query {makeframe=2} query puts {Content-type: text/html Suchresultate } puts "" puts { } exit 0 } if [regexp {makeframe=2} $query] { set noframe 0; set frbr
; set frp ""; set frtrg {target="bildrechts"} } { set noframe 1; set frbr ""; set frp

; set frtrg "" } puts {Content-type: text/html Suchresultate
Suchresultate
Suchkriterien:    } proc empty {w} { return [expr [string match "" $w]||[string match "keine+Angabe" $w]] } # Alphabet Deutsch if [regexp {namedt=([0-9a-zA-Z+%\-|]*)} $query z namedt] { if ![empty $namedt] { set namedt [decode $namedt] puts "Deutscher Name: $namedt | " } } { set namedt "" } if [regexp {anfangdt=([0-9a-zA-Z+%\-|]*)} $query z anfangdt] { if ![empty $anfangdt] { set anfangdt [decode $anfangdt] puts "Deutscher Name beginnt mit: $anfangdt | " } } { set anfangdt "" } # Alphabet Latein if [regexp {namelt=([0-9a-zA-Z+%\-|]*)} $query z namelt] { if ![empty $namelt] { set namelt [decode $namelt] puts "Botanischer Name: $namelt | " } } { set namelt "" } if [regexp {anfanglt=([0-9a-zA-Z+%\-|]*)} $query z anfanglt] { if ![empty $anfanglt] { set anfanglt [decode $anfanglt] puts "Botanischer Name beginnt mit: $anfanglt | " } } { set anfanglt "" } # Farbe if [regexp {farbe=([0-9a-zA-Z+%\-]*)} $query z farbe] { if ![empty $farbe] { foreach j { {keine+Angabe ""} {Rot 1} {Gelb%2FBraun 3} {Gr%FCn 4} {Blau 5} {Rosa%2FViolett 6} {Wei%DF 7} } { set rpl([lindex $j 0]) [lindex $j 1] } if [catch {set farbe $rpl($farbe)}] { } puts "Blütenfarbe: $farbe | " } { set farbe "" } } { set farbe "" } # Wuchshoehe if [regexp {hoehe=([0-9a-zA-Z+%\-]*)} $query z hoehe] { if ![empty $hoehe] { puts "Wuchshöhe: $hoehe | " } } { set hoehe "" } if [regexp {hoehemax=([0-9a-zA-Z+%\-]*)} $query z hoehemax] { if ![empty $hoehemax] { puts "Wuchshöhe/max.: $hoehemax | " } } { set hoehemax 0 } # Zeitangabe if [regexp {monat=([0-9a-zA-Z+%\-]*)} $query z monat] { if ![empty $monat] { foreach j { {1 Januar} {2 Februar} {3 M%E4rz} {4 April} {5 Mai} {6 Juni} {7 Juli} {8 August} {9 September} {10 Oktober} {11 November} {12 Dezember} } { set mrpl([lindex $j 1]) [lindex $j 0] } if [catch {set monat $mrpl($monat)}] { } puts "Monat: $monat | " } { set monat "" } } { set monat "" } if [regexp {photo=} $query z] { set photo 1 } { set photo 0 } # Schutzkategorie if [regexp {schutz=([0-9a-zA-Z+%\-]*)} $query z schutz] { if ![empty $schutz] { foreach j { {keine+Angabe ""} {{vom+Aussterben+bedroht} 1} {{stark+gef%E4hrdet} 2} {{gef%E4hrdet} 3} {{nicht+gesch%FCtzt} n} } { set srpl([lindex $j 0]) [lindex $j 1] } if [catch {set schutz $srpl($schutz)}] { } puts "Schutzkategorie: $schutz | " } { set schutz "" } } { set schutz "" } # Sortier-Option (L Latein oder D Deutsch) if [regexp {sortier=([0-9a-zA-Z+%\-]*)} $query z sortier] { if [string match $sortier {Botanischer+Name}] { set S 1 } { set S 2 } } { set S 1 } puts {
} #puts $query #NEW: CONSTRUCT THE PATTERN set pattern "" proc dazu {was} { global schon pattern if $schon { append pattern && } append pattern $was set schon 1 } set schon 0 if ![string match "" $namedt] { dazu "\[string match -nocase \"*$namedt*\" \[lindex \$line 1\]\]" } if ![string match "" $anfangdt] { dazu "\[string match \[string index \[lindex \$line 1\] 0\] $anfangdt\]" } if ![string match "" $namelt] { dazu "\[string match -nocase \"*$namelt*\" \[lindex \$line 0\]\]" } if ![string match "" $anfanglt] { dazu "\[string match \[string index \[lindex \$line 0\] 0\] $anfanglt\]" } if ![string match "" $farbe] { dazu "\[string match $farbe \[lindex \$line 4\]\]" } if $hoehemax { if ![string match "" $hoehe] { dazu "\[lindex \$line 5\]<=$hoehemax&&\[lindex \$line 6\]>=$hoehe" } } { if ![string match "" $hoehe] { dazu "\[lindex \$line 5\]<=$hoehe&&\[lindex \$line 6\]>=$hoehe" } } if ![string match "" $monat] { dazu "\[lindex \$line 7\]<=$monat&&\[lindex \$line 8\]>=$monat" } if ![string match "" $schutz] { dazu "\[string match $schutz \[lindex \$line 9\]\]" } if $photo { dazu "\[string match \"*.jpg\" \[lindex \$line 10\]\]"} #puts $pattern #NEW END CONSTRUCTING PATTERN set z "" foreach j { {1 Rot FF4000} {3 Gelb/Braun BF9F00} {4 Grün 00AF00} {5 Blau 0000FF} {6 Rosa/Violett DF00DF} {7 Weiß 000000} {"" - 000000} } { set f [lindex $j 0] set frb($f) [lindex $j 1] set far($f) [lindex $j 2] } foreach j { {1 Januar} {2 Februar} {3 März} {4 April} {5 Mai} {6 Juni} {7 Juli} {8 August} {9 September} {10 Oktober} {11 November} {12 Dezember} } { set f [lindex $j 0] set mon($f) [lindex $j 1] } if $S==2 { puts "Deutscher Name $frbr (Botanischer Name, Familie)" } { puts "Botanischer Name $frbr (Deutscher Name, Familie)" } if $noframe { puts {

} } { puts
} puts "Blütezeit | Wuchshöhe | Blütenfarbe | Schutzkategorie $frbr (1=max., n=nicht geschützt)" puts {


} #old #if $noframe { set uz "" } { set uz {target="_parent"} } #puts "
\[ Profisuche \]
\[ Einfache Suche \]
\[ Alphabetische Liste \]

" #if [catch {set output [exec /bin/awk -F, "$pattern {print}" $DATABASE | /usr/bin/sort -t, -d -k$S]} z] { puts $z } #NEW DO THE PATTERN SEARCH #puts "Starting search" set output "" set j 0 foreach line $database2 { if $pattern { incr j;lappend output $line } } puts "$j Treffer gefunden!

\n\n" #puts "Finished search" #NEW END PATTERN SEARCH foreach e $output { if ![string match "" [lindex $e 10]] { set link 1 } { set link 0 } if $link { puts "" } catch { if $S==2 { puts "[lindex $e 1] $frbr ([lindex $e 0], [lindex $e 2]) " } { puts "[lindex $e 0] $frbr ([lindex $e 1], [lindex $e 2]) " } if $link { puts "" } if [lindex $e 6]==0 { set hoehe "-" } { if [lindex $e 6]==$INFIN { set hoehe "[lindex $e 5]- cm" } { set hoehe "[lindex $e 5]-[lindex $e 6]cm" } } if [lindex $e 7]==0 { set zt "-" } { set zt $mon([lindex $e 7])-$mon([lindex $e 8])} if $noframe { puts "

" } { puts
} puts "$zt | $hoehe | " puts "$frb([lindex $e 4]) | " puts "[lindex $e 9]$frp


" } } #puts $output puts {
} }