#!/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 {
#<html><body>
#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 {</body></html>}
#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 "\\&auml;" w
	regsub -all %F6 $w "\\&ouml;" w
	regsub -all %FC $w "\\&uuml;" w
	regsub -all %C4 $w "\\&Auml;" w
	regsub -all %D6 $w "\\&Ouml;" w
	regsub -all %DC $w "\\&Uuml;" w
	regsub -all %DF $w "\\&szlig;" 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


    <HTML><HEAD>
    <TITLE>Suchresultate</TITLE></HEAD>

<frameset cols="30%,70%">
}
puts "<frame src=\"/cgi-bin/psearch.pl?$query\" name=\"listelinks\">\n<frame src=\"/leer.html\" name=\"bildrechts\">"
puts {
</frameset>
</html>

}
} {

    if [regexp {makeframe=1} $query] {
	regsub {makeframe=1} $query {makeframe=2} query
	puts {Content-type: text/html


    <HTML><HEAD>
    <TITLE>Suchresultate</TITLE></HEAD>

<frameset rows="100,*">
}
puts "<frame src=\"/suchleiste.html\" name=\"suchleiste\"><frame src=\"/cgi-bin/psearch.pl?$query\" name=\"listeunten\">"
puts {
</frameset>
</html>

}

exit 0
    }


    if [regexp {makeframe=2} $query] { set noframe 0; set frbr <br>; set frp ""; set frtrg {target="bildrechts"} } { set noframe 1; set frbr ""; set frp </p>; set frtrg "" }

puts {Content-type: text/html

             <HTML><HEAD>
             <TITLE>Suchresultate</TITLE></HEAD>
<BODY bgcolor=white>



<table bgcolor=beige width=100% valign=top>
<tr><td bgcolor=green>
<font color=white size=+2><b>Suchresultate</b></font><br>
</td></tr>
<tr><td>
Suchkriterien:&nbsp;&nbsp;&nbsp;
<font color=brown>
}

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&uuml;tenfarbe: $farbe | "
} { set farbe "" }   } { set farbe "" }

# Wuchshoehe
if [regexp {hoehe=([0-9a-zA-Z+%\-]*)} $query z hoehe] {
if ![empty $hoehe] {
puts "Wuchsh&ouml;he: $hoehe | "
}   } { set hoehe "" }

if [regexp {hoehemax=([0-9a-zA-Z+%\-]*)} $query z hoehemax] {
if ![empty $hoehemax] {
puts "Wuchsh&ouml;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 {<hr size=1 noshade><b>}

#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&uuml;n 00AF00}
    {5 Blau 0000FF}
    {6 Rosa/Violett DF00DF}
    {7 Wei&szlig; 000000}
    {"" </b>-<b> 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&auml;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 {<p align=right>} } { puts <br> }
puts "Bl&uuml;tezeit | Wuchsh&ouml;he | Bl&uuml;tenfarbe | Schutzkategorie $frbr (1=max., n=nicht gesch&uuml;tzt)"
puts {</p> </b>
</td>
</tr>
</table>

<hr size=2 noshade>}

#old
#if $noframe { set uz "" } { set uz {target="_parent"} }
#puts "<center><a href=\"$PROFISUCHE\" $uz><b>\[ Profisuche \]</b></a><br><a href=\"$EASYSUCHE\" $uz><b>\[ Einfache Suche \]</b></a><br><a href=\"$ALPHABETSUCHE\" $uz><b>\[ Alphabetische Liste \]</b></a></center><hr size=2 noshade>"

#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 "<b>$j Treffer gefunden!</b><p>\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 "<a href=\"$CGIBIN?[encode $e]\" $frtrg>" }
    catch {
	if $S==2 {
	    puts "<b>[lindex $e 1]</b> $frbr (<i>[lindex $e 0], [lindex $e 2]</i>) "
	} {
	    puts "<b>[lindex $e 0]</b> $frbr (<i>[lindex $e 1], [lindex $e 2]</i>) "
	}
	
	if $link { puts "</a>" }

	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 "<p align=right>" } { puts <br> }
	puts "$zt | $hoehe | "    
	puts "<font color=#$far([lindex $e 4])><b>$frb([lindex $e 4])</b></font> | "
	puts "[lindex $e 9]$frp<hr size=1 noshade>"
    }
}


#puts $output

puts {<br></BODY></HTML>}

}

