#!/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 |
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 |
\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