#!/usr/bin/env perl
# -*- perl -*-
#
# $Id: wapbbbike.cgi,v 2.19 2005/07/17 21:31:20 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2000,2001,2003,2004 Slaven Rezic. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: slaven@rezic.de
# WWW: http://bbbike.sourceforge.net
#
package BBBikeRouting::WAP;
BEGIN {
# see also webeditor/cgi-bin/we_redisys.cgi
if (defined $ENV{SERVER_SOFTWARE} &&
$ENV{SERVER_SOFTWARE} =~ m{(netscape|roxen|apache/2\.0)}i
) {
open(STDERR, ">/tmp/wapbbbike.log");
}
}
sub adjust_lib {
delete $INC{"FindBin.pm"};
require FindBin;
require lib;
"lib"->import("$FindBin::RealBin/..", "$FindBin::RealBin/../lib",
"$FindBin::RealBin/../BBBike", "$FindBin::RealBin/../BBBike/lib");
"lib"->import("/home/e/eserte/lib/perl"); # XXX fuer GD on cs
}
BEGIN { adjust_lib }
use BBBikeRouting;
use BBBikeVar;
@ISA = 'BBBikeRouting';
use strict;
use vars qw($use_apache_session);
$use_apache_session = 1 if !defined $use_apache_session;
sub wml {
my $s = shift;
$s =~ s/([&<>\$\x00-\x1f\x7f-\xff])/"".ord($1).";"/ge;
$s;
}
sub wap_can_table {
shift->{BrowserInfo}->{can_table};
}
sub _wap_hr {
print "
" . "-"x10 . "
";
}
sub wap_input {
my $self = shift;
print <wap_header ]}
Start
Straße:
Bezirk: Ziel
Straße:
Bezirk: Route zeigen
EOF
$self->_wap_hr;
print "
";
$self->_wap_info;
print <
@{[ $self->wap_footer ]}
EOF
}
sub wap_resolve_street {
my $self = shift;
print <wap_header ]}
EOF
my %has_postfields;
my %has_known_postfields;
for my $type (qw(Start Goal)) {
my $de_label = $type eq 'Goal' ? 'Ziel' : 'Start';
my $cgi_label = lc $de_label;
my $choices = $type . "Choices";
if ($self->$type() && $self->$type()->Coord) {
$has_known_postfields{$cgi_label}++;
} elsif (@{ $self->$choices() } == 0) {
print <Die ${de_label}straße ist nicht in
der Datenbank enthalten. Andere ${de_label}straße:
Straße:
Bezirk:
EOF
$has_postfields{$cgi_label}++;
} elsif (@{ $self->$choices() } > 1) {
print "
Mehrere ${de_label}straßen gefunden: ";
print "
";
}
}
print <Route zeigen
EOF
for my $type (qw(start ziel)) {
my $member = $type eq 'start' ? 'Start' : 'Goal';
if ($has_known_postfields{$type}) {
print <
EOF
} elsif ($has_postfields{$type}) {
print <
EOF
} else {
print <
EOF
}
}
print <
@{[ $self->wap_footer ]}
EOF
}
sub _wap_info {
my $self = shift;
print <Info
EOF
}
sub _wap_new_search {
my $self = shift;
print <Neue Anfrage
EOF
}
sub _def_citypart {
my $pos = shift;
if (defined $pos->Citypart) {
"(" . $pos->Citypart . ")";
} else {
"";
}
}
sub wap_output {
my $self = shift;
print <wap_header ]}
Route von
@{[$self->Start->Street]} @{[_def_citypart($self->Start)]} nach
@{[$self->Goal->Street]} @{[_def_citypart($self->Goal)]}
@{[ $self->wap_can_table ? $self->wap_output_table : $self->wap_output_notable ]}
EOF
if ($self->{Session}) {
my $q2 = $self->Context->CGI;
$q2->param("output_as", "imagepage");
$q2->param("sess", $self->{Session}{_session_id});
print <Als Grafik zeigen
EOF
} else {
print <Als Grafik zeigen
EOF
}
print <Rückweg
EOF
$self->_wap_new_search;
print <
@{[ $self->wap_footer ]}
EOF
}
sub wap_error {
my $self = shift;
my $errormessage = shift;
print <wap_header ]}
Fehler: @{[ wml($errormessage) ]}
@{[ $self->wap_footer ]}
EOF
}
sub _any_image {
my($self, %args) = @_;
my $cgi = $self->Context->CGI;
my $imagetype = "wbmp";
if ($cgi->Accept("image/gif")) {
$imagetype = "gif";
} elsif ($cgi->Accept("image/png")) {
$imagetype = "png";
}
my $convert_to = undef;
my %extra_args;
if ($BBBikeConf::wapbbbike_use_mapserver) {
if (!eval { require BBBikeDraw::MapServer; 1 }) {
warn $@ if $@;
} else {
# XXX Usually can't use gif with gd:
if ($imagetype ne 'png') {
if (!$cgi->Accept("image/png")) {
$convert_to = $imagetype;
}
$imagetype = "png";
}
$extra_args{Conf} = BBBikeDraw::MapServer::Conf->bbbike_cgi_ipaq_conf
(ImageType => $imagetype);
$extra_args{Module} = "MapServer";
}
}
my(@geometry) = $self->{BrowserInfo} && $self->{BrowserInfo}->{display_size} ? @{$self->{BrowserInfo}->{display_size}} : ();
if ($cgi->param("debug") || !@geometry) {
@geometry = (170, 144);
}
require BBBikeDraw;
my $draw = BBBikeDraw->new
(ImageType => $imagetype,
Geometry => join("x", @geometry),
Coords => [ map { join ",", @$_ } @{$self->Path} ],
Draw => ['str', 'wasser', 'flaechen', 'ubahn', 'sbahn'],
NoScale => ($geometry[0] < 400),
MarkerPoint => $args{markerpoint},
%extra_args,
);
if ($args{bbox}) {
$draw->set_bbox(@{ $args{bbox} });
}
$draw->draw_map;
$draw->draw_route;
if (defined $convert_to) {
$draw->{ImageType} = $convert_to;
print $cgi->header(-type => $draw->mimetype);
my $temp = "/tmp/wapbbbike." . time . ".$$";
open(FH, ">$temp") or die "Can't write to $temp: $!";
$draw->flush(Fh => \*FH);
close FH;
my $temp2cmd = "";
my $temp2;
if ($ENV{MOD_PERL}) {
$temp2 = "/tmp/wapbbbike2." . time . ".$$";
$temp2cmd = " > $temp2";
}
if ($convert_to eq 'gif') {
system("pngtopnm $temp | ppmquant 256 | ppmtogif $temp2cmd");
} else { # wbmp
system("pngtopnm $temp | ppmtopgm | pgmtopbm | pbmtowbmp $temp2cmd");
}
if (defined $temp2) {
open(IMG, $temp2) or die "Can't open file $temp2: $!";
local $/ = undef;
print ;
close IMG;
unlink $temp2;
}
unlink $temp;
} else {
print $cgi->header(-type => $draw->mimetype);
$draw->flush;
}
}
sub wap_image {
my $self = shift;
$self->_any_image;
}
sub wap_image_page {
my $self = shift;
my $q2 = $self->Context->CGI;
$q2->param("output_as", "image");
if ($self->{Session}) {
$q2->param("sess", $self->{Session}{_session_id});
}
my $start;
if ($self->Start && $self->Start->Street) {
$start = $self->Start->Street . " " . _def_citypart($self->Start);
} else {
$start = $q2->param("startname") || "???";
}
my $goal;
if ($self->Goal && $self->Goal->Street) {
$goal = $self->Goal->Street . " " . _def_citypart($self->Goal);
} else {
$goal = $q2->param("zielname") || "???";
}
print <wap_header ]}
Routenliste
EOF
$self->_wap_new_search;
print <
@{[ $self->wap_footer ]}
EOF
}
sub wap_surrounding_image {
my $self = shift;
my $center = $self->Context->CGI->param("center");
my($cx,$cy) = split /,/, $center;
$self->_any_image(bbox => [$cx-500,$cy-500,$cx+500,$cy+500],
markerpoint => $center);
}
# XXX This is not optimal! Better to check for tile borders and
# XXX create another image from there on...
sub wap_surrounding_image_page {
my $self = shift;
use constant FIRST => 0;
use constant PREV => 1;
use constant NEXT => 2;
use constant LAST => 3;
use constant PREVDIR => 4;
use constant NEXTDIR => 5;
use constant LAST_INX => 5;
my $q2 = $self->Context->CGI;
my $q3 = CGI->new($q2->query_string);
my @q;
my $path = $self->{Session}->{Path};
my $route_info = $self->{Session}->{RouteInfo};
my $center = $q2->param("center");
my $found;
my $label;
# First try to get a route point...
for my $i (0 .. $#$route_info) {
my $hop = $route_info->[$i];
if ($center eq $hop->{Coords}) {
$label = $hop->{Street};
if ($i > 0) {
$label .= " (" . $route_info->[$i-1]->{Whole} . ")";
}
for (0 .. LAST_INX) {
push @q, CGI->new($q2->query_string);
}
if ($i == 0) {
$q[FIRST] = $q[PREVDIR] = $q[PREV] = undef;
} else {
$q[FIRST]->param("center", $route_info->[0]->{Coords});
$q[PREV] ->param("center", $route_info->[$i-1]->{Coords});
TRY: {
for my $ii (reverse(0 .. $i-1)) {
if (defined $route_info->[$ii]->{Way} &&
$route_info->[$ii]->{Way} ne "") {
$q[PREVDIR]->param("center",
$route_info->[$ii]->{Coords});
last TRY;
}
}
$q[PREVDIR] = undef;
}
}
if ($i == $#$route_info) {
$q[NEXT] = $q[NEXTDIR] = $q[LAST] = undef;
} else {
$q[NEXT]->param("center", $route_info->[$i+1]->{Coords});
$q[LAST]->param("center", $route_info->[-1]->{Coords});
TRY: {
for my $ii ($i+1 .. $#$route_info) {
if (defined $route_info->[$ii]->{Way} &&
$route_info->[$ii]->{Way} ne "") {
$q[NEXTDIR]->param("center",
$route_info->[$ii]->{Coords});
last TRY;
}
}
$q[NEXTDIR] = undef;
}
}
$found++;
last;
}
}
if (!$found) {
warn "Nothing found in RouteInfo, fallback to search in Path";
# Fallback to searching in path
for my $i (0 .. $#$path) {
local $" = ",";
my $hop = $path->[$i];
if ($center eq "@{$hop}") {
for (0 .. 3) { # no PREVDIR and NEXTDIR
push @q, CGI->new($q2->query_string);
}
if ($i == 0) {
$q[FIRST] = $q[PREV] = undef; # no prev
} else {
$q[FIRST]->param("center", "@{$path->[0]}");
$q[PREV] ->param("center", "@{$path->[$i-1]}");
}
if ($i == $#$path) {
$q[NEXT] = $q[LAST] = undef; # no next
} else {
$q[NEXT]->param("center", "@{$path->[$i+1]}");
$q[LAST]->param("center", "@{$path->[-1]}");
}
last;
}
}
}
$q2->param("output_as", "surroundingimage");
$q3->param("output_as", "resultpage");
print <wap_header ]}