#!/usr/local/bin/perl -w

use strict;

my $file = "quotations.xml";
my $data;

if(open DATA, "<$file"){
   undef $/;
   $data = <DATA>;
   close DATA;
} else {
	print "content-type: text/html\n\n oops\n";
	exit 0;
}

my $param = $ENV{QUERY_STRING} || '';
my $n1  = "";
my $n2  = "";
my $filter= "";
if($param =~ /filter=(.*)/){
	$filter=$1;
	$param="";
}
if($param =~ /^(.*):(.*)/){
	$filter = $1;
	$param  = $2;
}
if($param =~ /(\d+)-(\d+)/){
	$n1 = $1;
	$n2 = $2;
} else {
	if($param =~ /(\d+)/){
		$n1 = $1;
		$n2 = $1;
	}
}
my $raw_filter=$filter;
$filter =~ s/\+/ /g;

my @data = ();

if(1){
	my @list = split /<quote>/, $data;
	foreach $_ (@list){
		s/<\/quote>.*//g;
		s/^\s+//g;
		s/\s+$//g;
		if($_){
			if(! $filter || $_ =~ /$filter/i){
				push @data, $_;
			}
		}		
	}
}

my $len = scalar @data;
my $quote = "";

if($n1 =~ /^\d+$/){
	if($n1 > $len){
		$n1 = $len -1 ;
	}
	if($n2 > $len){
		$n2 = $len -1 ;
	}
	foreach my $i ($n1 .. $n2){
		$quote .= any_one($i);
	}
} else {
	$quote .= any_one($n1);
}

sub print_html_header {
	print "content-type: text/html\n\n";
}
print_html_header();

my $prefix = "";
if($filter){
	$prefix = $raw_filter . ":";
}
my $rand = random_number();
my $next = $n2+1;
my $prev = $n1-1;
print <<__EOF__;
<head>
<style type="text/css">
body {
 font-family: Courier New, Courier, sans-serif;
 color: #00ff00;
 font-weight: bold;
}
a {
 color: red;
}
.detail {
 font-weight: normal;
 font-size: 100%;
}
.comment {
 font-weight: normal;
 font-size: 100%;
}
.source {
 text-align: right;
 font-weight: normal;
 font-size: 100%;
}
input {
  background-color: #99cc99;
  outline-color: red;
  border-color: black;
  color: black;
}
</style>
</head>
<body bgcolor=black>
    <p>
	<form action="q-html.pl">
	<a href="q-html.pl?$prefix$prev">prev quote</a>
	<a href="q-html.pl?$prefix$rand">random quote</a>
	<a href="q-html.pl?$prefix$next">next quote</a>
	random quote about...<input type=text name=filter value="$filter"></form>
	</p>
	<p>
	$quote
	</p>
<script src="http://www.google-analytics.com/urchin.js" type="text/javascript">
</script>
<script type="text/javascript">
_uacct = "UA-263370-1";
urchinTracker();
</script>
</body>
</html>
__EOF__

sub random_number {
	my $x = int(rand() * $len);
	return $x;
}

sub any_one {
	my ($n) = @_;
	my $cnt = 0;
  again:
	my $x = $n;
	if($n eq  ''){
		$x = int(rand() * $len);
		$n = '';
	} else {
		if($n !~ /^(\d+)$/){
			#
			# $n ist ein suchwort
			#
			$x = find_n($n);
		}
	}
	my $text = $data[$x];

	my $source= "";
	if($text =~ /(.*)<source>(.*)<\/source>/si){
		$text = $1;
		$source= $2;
	}
	my $text_comment   = "";
	my $source_comment = "";
	my $source_detail  = "";
	if($text =~ /(.*)<comment>(.*?)<\/comment>(.*)/si){
		$text = "$1\n$3";
		$text_comment = $2;
	}
	if($source =~ /(.*)<comment>(.*?)<\/comment>(.*)/si){
		$source = "$1\n$3";
		$source_comment = $2;
	}
	if($source =~ /(.*)<detail>(.*?)<\/detail>(.*)/si){
		$source = "$1\n$3";
		$source_detail = $2;
	}
	if($text =~ /<pre>(.*)<\/pre>/si){
		#
		# don't change the text
		#
	} else {
		$text =~ s/^\s+//g;			# remove unnecessary spaces at the start
		$text =~ s/\s+$//g;			# and at the end
		$text =~ s/<br>/\n\n/g;		# <br> => double newlines
		$text =~ s/<p.*?>/\n\n/g;	# <p> => double newlines
		$text =~ s/<.*?>//g;		# kill *all* html tags
		$text =~ s/ +/ /g;			# remove multi spaces
		$text =~ s/\n\n+/<br><br>/g;	# any sequence of newlines => 1 br
		$text =~ s/([\x80-\xff])/'&#' . ord($1) . ';'/eg; 	# escape dangerous characters
	}
	if(! $text){
		if($cnt ++ > 10){
			return "no more quotes";
		}		
		goto again;
	}	
	my $msg = "";
	my $info = "";
	if($filter){
		$info .= " about \"$filter\"";
	}
	$msg .= "<h1>Quote #$x $info</h1>";
	$msg .= "<p>$text</p>\n";
	if($text_comment){
		$msg .= "<p><font color=red>$text_comment</font></p>\n";
	}
	if($source){
		$msg .= "<p class=source>-- $source</p>\n";
	}
	if($source_detail){
		$msg .= "<p class=detail>[$source_detail]</p>\n";
	}
	if($source_comment){
		$msg .= "<p class=comment>($source_comment)</p>\n";
	}
	return $msg;
}

sub find_n {
	my ($n) = @_;
	my $i;
	my $x;

	foreach $x (@data){
		if($x =~ /$n/i){
			return $i;
		}
		$i ++;
	}
	return 0;
}
