#!/usr/bin/perl -w
#
# 20080909 flo	- Fixed waynode sorting by sequence not node_id
# 		- Fixed rounding error - should be 7 not 4 digits in lat/lon
# 		- Fixed closing relation and member/tag for relations
# 20080909 flo	- Added planetTimestamp and requestTimestamp in the header
# 20080921 flo	- Added escaping for usernames
# 20081022 flo	- Rewrite with CGI::Fast
# 		- Add pid file counting
#

use strict;
use DBI;
use POSIX;
use CGI qw/:standard/;
use CGI::Fast;
use Date::Parse;
use Time::HiRes qw/gettimeofday tv_interval/;

# http://www.openstreetmap.org/api/0.5/map?bbox=37.221680,11.594560,37.397461,11.709906

my $dbtimestamp="/home/flo/update/timestamp.txt";
my $stampdir="/home/flo/run/map";
my $maxtimeoffset=15*60;
my $maxinstances=5;
my $dbhost="dbi:Pg:dbname=osm";
my $dblogin="flo";
my $dbpass="flo";
my $maxload=10;
my $debug=0;

my %xmlescape = qw[ & &amp; < &lt; > &gt; ' &apos; " &quot; ];

sub escape {
	my ($s) = @_;

	return undef if (!defined($s));

	# \\\\ -> \
	$s =~ s/\\\\\\\\/\\/g;
	# \\e -> =
	$s =~ s/\\\\e/=/g;
	# \\s -> ;
	$s =~ s/\\\\s/;/g;
	
	$s =~ s/([&<>'"])/$xmlescape{$1}/g;

	return $s;
}

sub displayerror {
	my ($status, $msg) = @_;

	print header(-status=>$status),
		start_html(-title=>"Error " . $msg,
		-BGCOLOR=>'white',
		),
		h2($msg),
		end_html;

	printf(STDERR "$status $msg\n");
}

sub bboxinvalid {
	my (@bbox) = @_;

	# minlat > maxlat ?
	if ($bbox[0] > $bbox[2]) {
		return 1;
	}
	# minlon > maxlon ?
	if ($bbox[1] > $bbox[3]) {
		return 2;
	}

	if ($bbox[1] > 180 || $bbox[1] < -180) {
		return 3;
	}

	if ($bbox[3] > 180 || $bbox[3] < -180) {
		return 4;
	}

	if ($bbox[0] > 90 || $bbox[0] < -90) {
		return 5;
	}

	if ($bbox[2] > 90 || $bbox[2] < -90) {
		return 6;
	}

	return 0;
}

# Rails uses 0.25 - we are optimistic 
my $maxarea=0.75;

sub bboxoversized {
	my (@bbox) = @_;

	my $area=($bbox[2]-$bbox[0])*($bbox[3]-$bbox[1]);

	if ($area > $maxarea) {
		return 1;
	}	

	return 0;
}

sub getload {
	open(I, "/proc/loadavg") || return 0;
	my $line=<I>;
	close(I);

	my ($load1) = $line=~/^([\d\.]+)\s/;

	return $load1;
}

sub getdbtime {
	open(I, $dbtimestamp) || return;
	my $t=str2time(<I>);
	close(I);

	return $t;
}

sub onstaledb503 {
	my ($dbtime) = @_;
	my $age=time()-$dbtime;
	if ($age > $maxtimeoffset) {
		displayerror(503, "db stale - age $age seconds");
	}
}

sub header_dump {
	my ($dbtime, @bbox) = @_;
	print header(-type => "text/xml");

	printf("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n");
	printf("<osm version=\"0.5\" generator=\"ROMA mirror db - pgsql\"");
	printf(" planetTimestamp=\"%s\"", strftime("%Y-%m-%dT%H:%M:%SZ", gmtime($dbtime)));
	printf(" requestTimestamp=\"%s\"", strftime("%Y-%m-%dT%H:%M:%SZ", gmtime(time())));
	printf(">\n");
	printf("<bounds minlat=\"%s\" minlon=\"%s\" maxlat=\"%s\" maxlon=\"%s\"/>\n", 
		$bbox[0], $bbox[1], $bbox[2], $bbox[3]);
}

sub relations_dump {
	my ($dbh, $start) = @_;

	my $rsql=$dbh->prepare("
		select * from (
			select	r.id as id, 1 as o, r.user_name,
				to_char(r.tstamp, 'YYYY-MM-DD\"T\"HH24:MI:SS\"Z\"'), 
				null as memberid, null as memberrole, null as membertype,
				null, null
			from	relations r
			where	r.id in ( select * from tq_relationid )
			union
			select	rm.relation_id as id, 2 as o, null, null,
				rm.member_id as memberid, rm.member_role as memberrole,
				rm.member_type as membertype,
				null, null
			from	relation_members rm
			where	rm.relation_id in ( select * from tq_relationid )
			union
			select	rt.relation_id as id, 3 as o, null, null,
				null, null, null,
				rt.k, rt.v
			from	relation_tags rt
			where 	rt.relation_id in ( select * from tq_relationid )
			) as u
		order by id, o
		") or die $DBI::errstr;
		
	$rsql->execute() or die $DBI::errstr;

	my %reltype = qw[ 1 node 2 way 3 relation ];

	my $lrelid;
	my $relcount=0;
	while(my ($relid, $order, $user, $tstamp, $memid, $memrole, $memtype, $k, $v) = $rsql->fetchrow()) {
		if ($order eq 1) {
			if (defined($lrelid)) {
				printf("</relation>\n");
			}
			printf("<relation id=\"%d\" user=\"%s\" timestamp=\"%s\">\n", $relid, $user, $tstamp);
			$lrelid=$relid;
			$relcount++;
		} elsif ($order eq 2) {
			printf("\t<member type=\"%s\" ref=\"%d\" role=\"%s\"/>\n", $reltype{$memtype}, $memid, $memrole); 
		} elsif ($order eq 3) {
			printf("\t<tag k=\"%s\" v=\"%s\"/>\n", escape($k), escape($v));
		}
	}	
	if (defined($lrelid)) {
		printf("</relation>\n");
	}
	$rsql->finish();

	printf(STDERR "t9: %f\n", tv_interval($start)) if ($debug);

	return $relcount;
}

sub ways_dump {
	my ($dbh, $start) = @_;

	my $wsql=$dbh->prepare("
		select * from (
			select	w.id as id, 1 as o, w.user_name,
				to_char(w.tstamp, 'YYYY-MM-DD\"T\"HH24:MI:SS\"Z\"'), 
				null as node, null as seq, null as k, null as v
			from	ways w
			where	w.id in ( select id from tq_wayid )
			union
			select	wn.way_id as id, 2 as o, null, null,
				wn.node_id, wn.sequence_id, null, null
			from	tq_way_nodes wn
			union
			select	wt.way_id as id, 3 as o, null, null,
				null, null, wt.k, wt.v
			from	way_tags wt
			where	way_id in ( select id from tq_wayid )
			) as u
		order by id, o, seq
		") or die $DBI::errstr;
		
	$wsql->execute() or die $DBI::errstr;

	my $lwid;
	my $waycount=0;
	while(my ($wid, $order, $user, $tstamp, $node, $seq, $k, $v) = $wsql->fetchrow()) {
		if ($order eq 1) {
			if (defined($lwid)) {
				printf("</way>\n");
			}
			printf("<way id=\"%s\" user=\"%s\" timestamp=\"%s\">\n", $wid, $user, $tstamp);
			$lwid=$wid;
			$waycount++;
		} elsif ($order eq 2) {
			printf("\t<nd ref=\"%d\"/>\n", $node)
		} elsif ($order eq 3) {
			printf("\t<tag k=\"%s\" v=\"%s\"/>\n", escape($k), escape($v));
		}
	}
	if (defined($lwid)) {
		printf("</way>\n");
	}
	$wsql->finish();
	printf(STDERR "t8: %f\n", tv_interval($start)) if ($debug);

	return $waycount;
}

sub nodes_dump {
	my ($dbh, $start) = @_;
	my $nsql=$dbh->prepare("
		select	* from (
			select	n.id as id, 1 as o,
				round(CAST(ST_X(n.geom) as numeric),7) as lat,
				round(CAST(ST_Y(n.geom) as numeric),7) as lon,
				n.user_name,
				to_char(n.tstamp, 'YYYY-MM-DD\"T\"HH24:MI:SS\"Z\"'),
				null as k,
				null as v
			from	tq_nodes n
			union
			select	nt.node_id as id, 2 as o,
				null as lat, null as lon,
				null as user_name, null as tstamp,
				nt.k,
				nt.v
			from	node_tags nt
			where	nt.node_id in ( select id from tq_nodes )
			) as u
		order by id, o
		") or die $DBI::errstr;

	$nsql->execute() or die $DBI::errstr;


	my $lastnode;
	my $tags;
	my $nodecount=0;
	while(my ($nodeid, $order, $lat, $lon, $user, $tstamp, $k, $v) = $nsql->fetchrow()) {
		if ($order eq 1) {
			if (defined($lastnode)) {
				if ($tags> 0) {
					printf("</node>\n");
				} else {
					printf("/>\n");
				}
			}
			printf("<node id=\"%d\" lat=\"%s\" lon=\"%s\" user=\"%s\" timestamp=\"%s\"", 
				$nodeid, $lon, $lat, escape($user), $tstamp);
			$tags=0;
			$lastnode=$nodeid;
			$nodecount++;
		} elsif ($order eq 2) {
			printf("%s\t<tag k=\"%s\" v=\"%s\"/>\n", ($tags eq 0) ? ">\n" : "", escape($k), escape($v));
			$tags++;
		}
	}
	if (defined($lastnode)) {
		if ($tags> 0) {
			printf("</node>\n");
		} else {
			printf("/>\n");
		}
	}
	$nsql->finish();
	printf(STDERR "t7: %f\n", tv_interval($start)) if ($debug);

	return $nodecount;
}

sub relations_find {
	my ($dbh, $start) = @_;

	$dbh->do("
		insert into tq_relationid (
			select	relation_id
			from	relation_members
			where	member_id in ( select id from tq_nodes )
			and	member_type = 1
			union
			select	relation_id
			from	relation_members
			where	member_id in ( select id from tq_wayid )
			and	member_type = 2
		)
		");

	printf(STDERR "t5: %f\n", tv_interval($start)) if ($debug);

	$dbh->do("
		insert into tq_relationid
			select	relation_id
			from	relation_members
			where	member_id in ( select id from tq_relationid )
			and	member_type = 3
		");

	printf(STDERR "t6: %f\n", tv_interval($start)) if ($debug);
}

sub ways_find {
	my ($dbh, $start) = @_;
	$dbh->do("
		insert into tq_wayid
			select distinct way_nodes.way_id
			from way_nodes, tq_nodes_bbox
			where way_nodes.node_id = tq_nodes_bbox.id
		");

	printf(STDERR "t2: %f\n", tv_interval($start)) if ($debug);
}

sub nodes_find {
	my ($dbh, $start, @bbox) = @_;

	# # bbox=8.3426546875,51.88222734375,8.4305453125,51.92617265625
	# my ($minlon, $minlat, $maxlon, $maxlat)=split(",", $bboxstring);
	# my @bbox=($minlat, $minlon, $maxlat, $maxlon);

	my $sql=$dbh->prepare("
		insert into tq_nodes_bbox
			select	*
			from	nodes
			where	geom @ ST_SetSRID(
				ST_MakeBox2d(
					ST_MakePoint(?, ?), 
					ST_MakePoint(?, ?)), 
					4326);
			");

	$sql->execute($bbox[1], $bbox[0], $bbox[3], $bbox[2]);

	printf(STDERR "t1: %f\n", tv_interval($start)) if ($debug);
}

sub ways_find_nodes {
	my ($dbh, $start) = @_;
	$dbh->do("
		insert into tq_way_nodes
			select *
			from way_nodes
			where way_nodes.way_id in ( select id from tq_wayid )
		");

	printf(STDERR "t3: %f\n", tv_interval($start)) if ($debug);
}

sub nodes_uniq {
	my ($dbh, $start) = @_;

	$dbh->do("
		insert into tq_nodes
			select distinct * from (
				select  *
				from    nodes
				where   nodes.id in (
					select  node_id
					from    tq_way_nodes)
				union
				select *
				from    tq_nodes_bbox) distinctnodes;
		");

	printf(STDERR "t4: %f\n", tv_interval($start)) if ($debug);
}

sub osm_dump {
	my ($dbh, $dbtime, $start, @bbox) = @_;

	header_dump($dbtime, @bbox);

	$dbh->do("begin transaction");

	$dbh->do("SET default_tablespace = mirrored");
	$dbh->do("create temp table tq_nodes_bbox ( like nodes ) on commit drop");
	$dbh->do("create temp table tq_nodes ( like nodes ) on commit drop");
	$dbh->do("create temp table tq_wayid ( id bigint ) on commit drop");
	$dbh->do("create temp table tq_relationid ( id bigint ) on commit drop");
	$dbh->do("create temp table tq_way_nodes ( like way_nodes ) on commit drop");
	$dbh->do("create temp table tq_relations ( like relations ) on commit drop");

	printf(STDERR "t0: %f\n", tv_interval($start)) if ($debug);

	nodes_find($dbh, $start, @bbox);
	ways_find($dbh, $start);
	ways_find_nodes($dbh, $start);
	nodes_uniq($dbh, $start);
	relations_find($dbh, $start);

	my $nodecount=nodes_dump($dbh, $start);
	my $waycount=ways_dump($dbh, $start);
	my $relcount=relations_dump($dbh, $start);

	$dbh->do("end");

	printf("</osm>\n");

	printf(STDERR "Request done - time:%f nodes:%d ways:%d relations:%d\n", 
		tv_interval($start), $nodecount, $waycount, $relcount);
}

sub numinstances {
	opendir(DIR, $stampdir) || return 0;
	my @files = grep { !/^\./ } readdir(DIR);
	closedir DIR;

	return scalar @files;
}

sub createpid {
	open(O, ">" . $stampdir . "/" . $$) || return 0;
	close(O);
}

sub removepid {
	unlink $stampdir . "/" . $$;
}

$SIG{TERM}=sub { removepid(); exit(0); };
$SIG{INT}=sub { removepid(); exit(0); };

my $dbh = DBI->connect($dbhost, $dblogin, $dbpass) or displayerror(503, "Could not connect to database");

while(new CGI::Fast) {
	my $load=getload();
	if ($load > $maxload) {
		displayerror(503, "1min loadavg to high ($load) - come back later");
		next;
	}

	createpid();

	if (numinstances() gt $maxinstances) {
		displayerror(503, "Concurrency limit reached");
		removepid();
		next;
	}

	my $start=[gettimeofday];
	my $dbtime=getdbtime();

	#
	# bbox=8.3426546875,51.88222734375,8.4305453125,51.92617265625
	#
	my $bboxstring=param("bbox");

	if (!defined($bboxstring) || $bboxstring !~ /^[\d\,\.\-]+$/) {
		displayerror(400, "BBox string broken");
		removepid();
		next;
	}
	printf(STDERR "request for bbox %s\n", $bboxstring);

	my ($minlon, $minlat, $maxlon, $maxlat)=split(",", $bboxstring);
	my @bbox=($minlat, $minlon, $maxlat, $maxlon);

	if (bboxinvalid(@bbox)) {
		displayerror(400, "BBox invalid");
		removepid();
		next;
	}

	if (bboxoversized(@bbox)) {
		displayerror(413, "BBox to large");
		removepid();
		next;
	}
	
	osm_dump($dbh, $dbtime, $start, @bbox);

	removepid();
}

$dbh->disconnect();
exit(0);

END {
	removepid();
}