#!/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 ]}

Route von $start nach $goal
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 ]}

Umgebungskarte EOF if (defined $label) { print "
" . wml($label) . "
"; } print <

EOF if ($q[FIRST]) { print "url(-absolute => 1,-path_info=>1,-query=>1) . "\">|< "; } if ($q[PREVDIR]) { print "url(-absolute => 1,-path_info=>1,-query=>1) . "\"><< "; } if ($q[PREV]) { print "url(-absolute => 1,-path_info=>1,-query=>1) . "\">< "; } if ($q[NEXT]) { print "url(-absolute => 1,-path_info=>1,-query=>1) . "\">> "; } if ($q[NEXTDIR]) { print "url(-absolute => 1,-path_info=>1,-query=>1) . "\">>> "; } if ($q[LAST]) { print "url(-absolute => 1,-path_info=>1,-query=>1) . "\">>| "; } print <Routenliste
EOF $self->_wap_new_search; print < @{[ $self->wap_footer ]} EOF } sub _surrounding_href { my($self, $hop) = @_; my $out = ""; if ($self->{Session}) { $out .= "Context->CGI->script_name . "?output_as=surroundingimagepage;sess=" . $self->{Session}{_session_id} . ";center=" . $hop->{Coords} . "\">"; } $out .= wml($hop->{Street}); if ($self->{Session}) { $out .= ""; } $out; } sub wap_output_table { my $self = shift; my $out = "\n"; foreach (@{ $self->RouteInfo }) { $out .= "\n"; } $out .= "
"; if (defined $_->{Way} && $_->{Way} ne "") { $out .= $_->{Way}; } $out .= ""; if (defined $_->{Street}) { $out .= $self->_surrounding_href($_); } $out .= "
\n"; $out; } sub wap_output_notable { my $self = shift; my $out = ""; foreach (@{ $self->RouteInfo }) { if (defined $_->{Way} && $_->{Way} ne "") { $out .= "$_->{Way} => "; } if (defined $_->{Street}) { $out .= $self->_surrounding_href($_); } $out .= "
\n"; } $out; } sub wap_info { my $self = shift; print <wap_header ]}

BBBike
Routensuche für Radfahrer in Berlin
von Slaven Rezic [$BBBike::EMAIL]

Statt eines Straßennamens kann auch eine Kreuzung in der Schreibweise
  Straße/Kreuzende Straße
angegeben werden. Die Angabe des Bezirks ist optional.

@{[ $self->wap_footer ]} EOF } sub wap_cgi_object { my $self = shift; require CGI; CGI->import('-newstyle_urls'); my $q = $self->Context->CGI(CGI->new); eval { require BrowserInfo; my $bi = $self->Context->BrowserInfo(BrowserInfo->new($q)); $self->{BrowserInfo} = $bi; }; warn $@ if $@; $q; } sub wap_std_header { my $self = shift; return if $ENV{WAPBBBIKE_FROM_CMDLINE}; my %args = @_; # Don't be defensive --- better to maintain a list of devices # where caching is crucial... print $self->Context->CGI->header (-type => "text/vnd.wap.wml", #-expires => "now", #'-cache-control' => 'no-cache', %args); } sub wap_init { my $self = shift; my %args; $self->wap_cgi_object; $self->Context->CGI; } sub wap_header { my $self = shift; < EOF } sub wap_footer { my $self = shift; < EOF } # Add the last point manually --- or should this be done in BBBikeRouting? XXX sub search { my $self = shift; $self->SUPER::search(@_); my $route_info = $self->RouteInfo; my $path = $self->Path; if ($route_info && $path) { push @$route_info, {Street => "angekommen, " . $route_info->[-1]{Whole}, Coords => join ",", @{$path->[-1]}, }; } } sub tie_session { my $id = shift; return unless $use_apache_session; if (!eval {require Apache::Session::DB_File}) { $use_apache_session = undef; #warn $@; return; } tie my %sess, 'Apache::Session::DB_File', $id, { FileName => "/tmp/wapbbbike_sessions_" . $< . ".db", # XXX make configurable LockDirectory => '/tmp', } or do { $use_apache_session = undef; #warn $!; return; }; return \%sess; } return 1 if ((caller() and (caller())[0] ne 'Apache::Registry') or keys %Devel::Trace::); # XXX Tracer bug ###################################################################### adjust_lib() if $ENV{MOD_PERL}; use vars qw($routing $q $do_image $sess @member); @member = qw(Path RouteInfo Start Goal); sub get_session { my $routing = shift; for my $member (@member) { eval { $routing->$member($sess->{$member}); }; # catch errors if assigning "undef" to a object-expecting member } } sub store_session { my $routing = shift; for my $member (@member) { $sess->{$member} = $routing->$member(); } } $routing = BBBikeRouting->new->init_context; $routing->Context->MultipleChoicesLimit(7); bless $routing, 'BBBikeRouting::WAP'; # 5.005 compat $routing->read_conf("$FindBin::RealBin/bbbike.cgi.config"); $BBBikeConf::wapbbbike_use_mapserver = $BBBikeConf::wapbbbike_use_mapserver; # cease -w $q = $routing->wap_init; $do_image = defined $q->param("output_as") && ($q->param("output_as") eq 'image' || $q->param("output_as") eq 'surroundingimage'); $routing->wap_std_header if !$do_image; for my $type (qw(start ziel)) { if ($q->param("${type}namebezirk")) { my($street, $citypart) = split /\|/, $q->param("${type}namebezirk"); $q->param("${type}name", $street); $q->param("${type}bezirk", $citypart); } } $sess = tie_session($q->param("sess")); $routing->{Session} = $sess; if ($q->param("info")) { $routing->wap_info(); } elsif (defined $q->param("output_as") && $q->param("output_as") eq 'imagepage') { $routing->get_session; $routing->wap_image_page; } elsif (defined $q->param("output_as") && $q->param("output_as") eq 'surroundingimagepage') { $routing->get_session; $routing->wap_surrounding_image_page; } elsif (defined $q->param("output_as") && $q->param("output_as") eq 'image' && $sess && $sess->{Path}) { $routing->get_session; $routing->wap_image; } elsif (defined $q->param("startname") && $q->param("startname") ne "" && defined $q->param("zielname") && $q->param("zielname") ne "" ) { $routing->Start->Street ($q->param("startname")); $routing->Goal->Street ($q->param("zielname")); $routing->Start->Citypart($q->param("startbezirk")); $routing->Goal->Citypart ($q->param("zielbezirk")); my $has_start = $routing->get_start_position; my $has_goal = $routing->get_goal_position; if (!$has_start || !$has_goal) { $routing->wap_resolve_street; } else { if ($do_image) { # Search or session if (!$sess || !$sess->{Path}) { $routing->search; } else { $routing->get_session; } $routing->wap_image; } else { $routing->search; $routing->wap_output; if ($sess) { $routing->store_session; } } } } elsif (defined $q->param("output_as") && $q->param("output_as") eq 'resultpage') { if (!$sess || !$sess->{Path}) { $routing->wap_error("Die Session ist nicht mehr gültig!"); } else { $routing->get_session; $routing->wap_output; } } elsif (defined $q->param("output_as") && $q->param("output_as") eq 'surroundingimage') { # Search or session if (!$sess || !$sess->{Path}) { $routing->search; $routing->store_session; } else { $routing->get_session; } $routing->wap_surrounding_image; } else { $routing->wap_input(); } untie %$sess if $sess;