1#!/usr/bin/env perl
2# -*- perl -*-
3
4#
5# $Id: BBBikeRouting.pm,v 1.44 2007/05/31 20:04:11 eserte Exp $
6# Author: Slaven Rezic
7#
8# Copyright (C) 2000,2001,2003 Slaven Rezic. All rights reserved.
9# This program is free software; you can redistribute it and/or
10# modify it under the same terms as Perl itself.
11#
12# Mail: slaven@rezic.de
13# WWW:  http://bbbike.sourceforge.net
14#
15
16package BBBikeRouting;
17
18BEGIN { $^W = 0 }
19
20use strict;
21use BBBikeUtil;
22
23require myclassstruct;
24
25{
26    package BBBikeRouting::Position;
27    use vars qw($Members);
28    $Members =
29	{Street => "\$", Citypart => "\$",
30	 City => "\$",
31	 ZIP => "\$",
32	 Coord => "\$", Multi => "\$",
33	 Attribs => "\$",
34	};
35    myclassstruct->import(keys %$Members);
36}
37
38{
39    package BBBikeRouting::Context;
40    use vars qw($Members);
41    $Members =
42	{Vehicle => "\$", Scope => "\$",
43	 Velocity => "\$",
44	 UseXS => "\$", UseCache => "\$",
45	 PreferCache => "\$",
46	 UseNetServer => "\$",
47	 ZIPLookArgs => "\$",
48	 SearchArgs => "\$", Algorithm => "\$",
49	 CGI => "\$", BrowserInfo => "\$",
50	 RouteInfoKm => "\$",
51	 Verbose => "\$",
52	 MultipleChoices => "\$",
53	 MultipleChoicesLimit => "\$",
54	 ChooseExactCrossing => "\$",
55	 UseTelbuchDBApprox => "\$",
56	};
57    myclassstruct->import(keys %$Members);
58}
59
60{
61    use vars qw($Members);
62    $Members =
63	{Context => "BBBikeRouting::Context",
64	 Start => "BBBikeRouting::Position",
65	 StartChoices => "\$", # array of BBBikeRouting::Position
66	 StartChoicesIsCrossings => "\$",
67	 Via => "\$", # array of BBBikeRouting::Position
68	 ViaChoices => "\$", # XXX not used yet
69	 ViaChoicesIsCrossings => "\$",
70	 Goal => "BBBikeRouting::Position",
71	 GoalChoices => "\$", # array of BBBikeRouting::Position
72	 GoalChoicesIsCrossings => "\$",
73	 Dataset => "\$",
74	 Streets => "\$", ZIP => "\$",
75	 ZIPStreets => "\$", Net => "\$",
76	 Stations => "\$", Cities => "\$",
77	 Crossings => "\$",
78	 Path => "\$", RouteInfo => "\$",
79	 #PenaltyNets => "\$",
80	 Ext => "\$", # for subclassing
81	};
82    myclassstruct->import(keys %$Members);
83}
84
85sub BBBikeRouting_Position_Class { 'BBBikeRouting::Position' }
86sub BBBikeRouting_Context_Class  { 'BBBikeRouting::Context'  }
87sub Strassen_Dataset_Class       { 'Strassen::Dataset'       }
88
89sub BBBikeRouting::Position::reset {
90    my $self = shift;
91    for my $member (keys %$BBBikeRouting::Position::Members) {
92	$self->$member(undef);
93    }
94}
95
96sub BBBikeRouting::LastVia {
97    my $self = shift;
98    if (ref $self->Via eq 'ARRAY') {
99	$self->Via->[-1];
100    } else {
101	undef;
102    }
103}
104
105sub BBBikeRouting::Context::ExpandedScope {
106    my $self = shift;
107    if    ($self->Scope eq 'city')       { [qw(city)] }
108    elsif ($self->Scope eq 'region')     { [qw(city region)] }
109    elsif ($self->Scope eq 'wideregion') { [qw(city region wideregion)] }
110    else {
111	die "Unknown scope: " . $self->Scope;
112    }
113}
114
115sub factory {
116    my($class, $vehicle, %args) = @_;
117    if ($vehicle =~ qr{^(bike|car|oepnv)$}) {
118	$class->new(%args);
119    } else {
120	my $new_class = "BBBikeRouting::" . ucfirst($vehicle);
121	eval 'use ' . $new_class;
122	die $@ if $@;
123	$new_class->new(%args);
124    }
125}
126
127sub init_context {
128    my $self = shift;
129    my $context = $self->BBBikeRouting_Context_Class->new;
130    $self->Context($context);
131    $self->Start($self->BBBikeRouting_Position_Class->new);
132    $self->StartChoices([]);
133    $self->StartChoicesIsCrossings(0);
134    $self->Via([]);
135    $self->ViaChoices([]);
136    $self->Goal($self->BBBikeRouting_Position_Class->new);
137    $self->GoalChoices([]);
138    $self->GoalChoicesIsCrossings(0);
139    if ($self->Strassen_Dataset_Class eq 'Strassen::Dataset') {
140	# Just for convenience:
141	require Strassen::Dataset;
142    }
143    $self->Dataset($self->Strassen_Dataset_Class->new);
144    $context->Vehicle("bike");
145    $context->Velocity(kmh2ms(20));
146    $context->Scope("city");
147    $context->UseXS(1);
148    $context->UseNetServer(0);
149    $context->UseCache(1);
150    $context->PreferCache(0);
151    $context->Algorithm("A*");
152    $context->RouteInfoKm(1);
153    $context->MultipleChoices(1);
154    $context->MultipleChoicesLimit(undef);
155    $context->ChooseExactCrossing(0);
156    $context->UseTelbuchDBApprox(0);
157    $self;
158}
159
160sub read_conf {
161    my $self = shift;
162    my $file = shift;
163    {
164	package BBBikeConf;
165	do $file;
166    }
167    my $context = $self->Context;
168    $BBBikeConf::search_algorithm = "A*"
169	if !defined $BBBikeConf::search_algorithm;
170    $context->Algorithm($BBBikeConf::search_algorithm);
171}
172
173# Remove all routing information (Start, Goal, Path, ...)
174sub reset {
175    my $self = shift;
176    $self->Path(undef);
177    $self->RouteInfo(undef);
178    $self->Start($self->BBBikeRouting_Position_Class->new);
179    $self->StartChoices([]);
180    $self->StartChoicesIsCrossings(0);
181    $self->Via([]);
182    $self->ViaChoices([]);
183    $self->Goal($self->BBBikeRouting_Position_Class->new);
184    $self->GoalChoices([]);
185    $self->GoalChoicesIsCrossings(0);
186}
187
188sub dump {
189    my $self = shift;
190    require Data::Dumper;
191    my @keys = grep { !/^(Dataset|Streets|ZIP|ZIPStreets|Net|Stations|Cities|Crossings)$/ } keys %$BBBikeRouting::Members;
192    my @values = map { $self->$_() } @keys;
193    Data::Dumper->new([@values], [@keys])->Indent(1)->Dump;
194}
195
196# Remove all data references and routing information, and change the scope
197sub change_scope {
198    my($self, $scope) = @_;
199    $self->Context->Scope($scope);
200    $self->Dataset($self->Strassen_Dataset_Class->new);
201    $self->Streets(undef);
202    $self->ZIP(undef);
203    $self->ZIPStreets(undef);
204    $self->Net(undef);
205    $self->Stations(undef);
206    $self->Crossings(undef);
207    $self->Cities(undef);
208    $self->reset;
209}
210
211sub init_str {
212    my $self = shift;
213    if (!$self->Streets) {
214	my $context = $self->Context;
215	require Strassen::Core;
216	if ($context->Vehicle eq 'oepnv') {
217	    my $sstr = $self->Dataset->get("str","b",$context->ExpandedScope);
218	    $sstr = Strassen->new_copy_restricted($sstr,
219						  -restrictions => [qw/S0/]);
220	    my $ustr = $self->Dataset->get("str","u",$context->ExpandedScope);
221	    $ustr = Strassen->new_copy_restricted($ustr,
222						  -restrictions => [qw/U0/]);
223	    require Strassen::MultiStrassen;
224	    $self->Streets(MultiStrassen->new($sstr, $ustr));
225	} else {
226	    $self->Streets($self->Dataset->get("str","s",$context->ExpandedScope));
227	    if ($context->Vehicle eq 'car') {
228		$self->Streets(Strassen->new_copy_restricted
229			       ($self->Streets, -restrictions => [qw/NN/]));
230	    }
231	}
232    }
233    $self->Streets;
234}
235
236sub init_zip {
237    my $self = shift;
238    if (!$self->ZIP) {
239	require PLZ;
240	$self->ZIP(PLZ->new());
241    }
242    $self->ZIP;
243}
244
245sub init_zip_s {
246    my $self = shift;
247    if (!$self->ZIPStreets) {
248	$self->ZIPStreets($self->init_zip->as_streets);
249    }
250    $self->ZIPStreets;
251}
252
253sub init_cities {
254    my $self = shift;
255    if (!$self->Cities) {
256	$self->Cities($self->Dataset->get("p", "o", $self->Context->ExpandedScope));
257    }
258    $self->Cities;
259}
260
261sub init_net {
262    my $self = shift;
263    if (!$self->Net) {
264	require Strassen::StrassenNetz;
265	my $context = $self->Context;
266	$self->init_str;
267	if ($context->UseXS) {
268	    eval q{ use BBBikeXS };
269	}
270	if ($context->Vehicle eq 'oepnv') {
271	    $self->Net(StrassenNetz->new($self->Streets));
272	    die "NYI XXX" if $context->Algorithm eq 'C-A*-2';
273	    $self->Net->make_net(UseCache => $context->UseCache,
274				 PreferCache => $context->PreferCache);
275	    $self->init_stations;
276	    $self->Net->add_umsteigebahnhoefe($self->Stations,
277					      -addmapfile => 'umsteigebhf');
278	} else {
279	    $self->Net(StrassenNetz->new_from_best
280		       (Strassen => $self->Streets,
281			OnCreate => sub {
282			    if ($context->Algorithm eq 'C-A*-2') {
283				#require StrassenNetz::CNetFileDist;
284				#StrassenNetz::CNetFile::make_net($_[0]);
285				$_[0]->use_data_format($StrassenNetz::FMT_MMAP);
286				$_[0]->make_net(-addcacheid => $context->Vehicle);
287				$_[0]->make_sperre
288					('gesperrt',
289					 Type => ['einbahn', 'sperre',
290						  'wegfuehrung']);
291				# XXX make_sperre nyi
292			    } else {
293				$_[0]->make_net(UseCache => $context->UseCache,
294						PreferCache => $context->PreferCache,
295					       );
296				if ($context->Vehicle eq 'bike') {
297				    $_[0]->make_sperre
298					('gesperrt',
299					 Type => ['einbahn', 'sperre',
300						  'wegfuehrung']);
301				} elsif ($context->Vehicle eq 'car') {
302				    $_[0]->make_sperre
303					('gesperrt',
304					 Type => ['einbahn', 'sperre',
305						  'tragen', 'wegfuehrung']);
306				    $_[0]->make_sperre
307					('gesperrt_car',
308					 Type => ['einbahn', 'sperre',
309						  'tragen', 'wegfuehrung']);
310				}
311			    }
312			},
313			NoNewFromServer => !$context->UseNetServer,
314		       ));
315	}
316    }
317    $self->Net;
318}
319
320sub init_crossings {
321    my $self = shift;
322    if (!$self->Crossings) {
323	$self->do_init_crossings;
324	$self->Crossings->make_grid(UseCache => $self->Context->UseCache);
325    }
326    $self->Crossings;
327}
328
329sub do_init_crossings {
330    my $self = shift;
331    if ($self->Context->Vehicle eq 'oepnv') {
332	$self->do_init_crossings_with_stations;
333    } else {
334	$self->do_init_crossings_with_streets;
335    }
336}
337
338sub do_init_crossings_with_streets {
339    my $self = shift;
340    require Strassen::Kreuzungen;
341    $self->Crossings
342	(Kreuzungen->new(Strassen => $self->init_str,
343			 WantPos => 1,
344			 Kurvenpunkte => 1,
345			 UseCache => $self->Context->UseCache)
346	);
347}
348
349sub do_init_crossings_with_stations {
350    my $self = shift;
351    require Strassen::Kreuzungen;
352    $self->Crossings
353	(Kreuzungen->new_from_strassen(Strassen => $self->init_stations,
354				       WantPos => 1,
355				       Kurvenpunkte => 1,
356				       UseCache => $self->Context->UseCache)
357	);
358}
359
360sub init_stations {
361    my $self = shift;
362    if (!$self->Stations) {
363	my $ubhf = $self->Dataset->get("p","u",$self->Context->ExpandedScope);
364	my $sbhf = $self->Dataset->get("p","b",$self->Context->ExpandedScope);
365	require Strassen::MultiStrassen;
366	$self->Stations(MultiStrassen->new($sbhf, $ubhf));
367    }
368    $self->Stations;
369}
370
371foreach (qw(Start Goal)) {
372    my $c='sub get_'.lc($_).'_position { shift->get_position(\''.$_.'\', @_) }';
373#    warn $c;
374    eval $c;
375}
376
377# A return value of undef means multiple matches or no match. Please look
378# into $self->...Choices.
379sub resolve_position {
380    my $self = shift;
381    my $pos_o = shift;
382    my $choices_o = shift;
383    my $street = shift || $pos_o->Street;
384    my $citypart = shift || $pos_o->Citypart;
385    my(%args) = @_;
386    my $fixposition = $args{fixposition};
387    my $type = $args{type};
388    if (!defined $fixposition) { $fixposition = 1 }
389    my $context = $self->Context;
390
391    if ($context->Vehicle eq 'oepnv') {
392	my $ret = $self->Stations->get_by_name($street, 0);
393	if (!$ret) {
394	    $ret = $self->Stations->get_by_name("^(?i:\Q$street\E)", 1);
395	}
396	if ($ret) {
397	    $pos_o->Street($ret->[Strassen::NAME()]);
398	    $pos_o->Citypart(undef);
399	    $pos_o->Coord($ret->[Strassen::COORDS()]->[0]);
400	    return $pos_o->Coord;
401	} # else fallback to streets
402    }
403
404    if (defined $pos_o->City) {
405	my $city = $pos_o->City;
406	my $cities = $self->init_cities;
407	my $ret = $cities->get_by_name($city, 0);
408	if (!$ret) {
409	    $ret = $cities->get_by_name("^(?i:\Q$city\E)", 1);
410	}
411	if ($ret) {
412	    $pos_o->City($ret->[Strassen::NAME()]);
413	    $pos_o->Street(undef);
414	    $pos_o->Citypart(undef);
415	    $pos_o->Coord($ret->[Strassen::COORDS()]->[0]);
416	    return $pos_o->Coord;
417	} # else fallback
418	warn "Can't find city $city in @{[ $cities->file ]}, fallback to streets";
419    }
420
421    if ($context->UseTelbuchDBApprox) {
422	# XXX experimental, does not have ChooseExactCrossing implemented
423	my $coord;
424	my $return;
425	eval {
426	    require TelbuchDBApprox;
427	    my $tb = TelbuchDBApprox->new(%args);
428	    my(@res) = $tb->search($street, undef, $citypart);
429	    if (@res == 1) {
430		$pos_o->Street  ($res[0]{Street});
431		$pos_o->Citypart($res[0]{Citypart});
432		$pos_o->Coord   ($res[0]{Coord});
433		$coord = $pos_o->Coord;
434		$return = 1;
435	    } elsif (@res && $context->MultipleChoices) {
436		my $limit = $context->MultipleChoicesLimit;
437		@$choices_o = ();
438		my %seen;
439		for (@res) {
440		    my $new_pos = $self->BBBikeRouting_Position_Class->new;
441		    my $key = "$_->{Street}, $_->{Citypart}";
442		    next if $seen{$key};
443		    $new_pos->Street  ($_->{Street});
444		    $new_pos->Citypart($_->{Citypart});
445		    $new_pos->Coord   ($_->{Coord});
446		    push @$choices_o, $new_pos;
447		    $seen{$key}++;
448		    last if defined $limit && @$choices_o >= $limit;
449		}
450		$return = 1;
451	    }
452	};
453	warn $@ if $@;
454	if ($return) {
455	    return $coord;
456	}
457    }
458
459    if (defined $street && $street =~ m|/|) { # StreetA/StreetB
460	my(@streets) = split m|/|, $street;
461	my %coords;
462	$self->init_str; # for $self->Streets
463	my @full_name;
464	for my $s (@streets) {
465	    my(@r) = $self->Streets->get_all_by_name("^(?i:" . quotemeta($s) . ".*)", 1);
466	    if (!@r) {
467		warn "Can't find $s in file @{[ $self->Streets->file ]}\n";
468		last;
469	    }
470	    if (!keys %coords) {
471		for my $r (@r) {
472		    for my $c (@{ $r->[Strassen::COORDS()] }) {
473			$coords{$c} = $r->[Strassen::NAME()];
474		    }
475		}
476	    } else {
477		for my $r (@r) {
478		    for my $c (@{ $r->[Strassen::COORDS()] }) {
479			if (exists $coords{$c}) {
480			    require Strassen::Strasse;
481			    my($street1, @cityparts1) = Strasse::split_street_citypart($coords{$c});
482			    my($street2, @cityparts2) = Strasse::split_street_citypart($r->[Strassen::NAME()]);
483			    $pos_o->Street($street1 . "/" . $street2);
484			    $pos_o->Citypart(join(", ", @cityparts1, @cityparts2) || undef);
485			    $pos_o->Coord($c);
486			    return $c;
487			}
488		    }
489		}
490	    }
491	}
492	warn "Cannot find anything for @streets,\nfallback to PLZ method with $streets[0] only\n";
493	$street = $streets[0];
494    }
495
496    if ($context->Scope eq 'city') {
497	$self->init_zip;
498	my $return_multiple = $context->MultipleChoices;
499	my(@from_res) = $self->ZIP->look_loop_best
500	    (PLZ::split_street($street),
501	     MultiZIP => !$return_multiple,
502	     MultiCitypart => !$return_multiple,
503	     Agrep => 'default',
504	     (defined $citypart ? (Citypart => $citypart) : ()),
505	     ($context->ZIPLookArgs ? @{ $context->ZIPLookArgs } : ()),
506	    );
507
508	if (@{ $from_res[0] }) {
509	    # remove entries without coord
510	    for(my $i = 0; $i <= $#{ $from_res[0] }; $i++) {
511		if (!$from_res[0]->[$i][PLZ::LOOK_COORD()]) {
512		    splice @{ $from_res[0] }, $i, 1;
513		    $i--;
514		}
515	    }
516	}
517
518	return undef if (!@{ $from_res[0] });
519
520	if (@{ $from_res[0] } > 1 && $context->MultipleChoices) {
521	    my $limit = $context->MultipleChoicesLimit;
522	    @$choices_o = ();
523	    for (@{ $from_res[0] }) {
524		my $new_pos = $self->BBBikeRouting_Position_Class->new;
525		$new_pos->Street  ($_->[PLZ::LOOK_NAME    ()]);
526		$new_pos->Citypart($_->[PLZ::LOOK_CITYPART()]);
527		$new_pos->Coord   ($_->[PLZ::LOOK_COORD   ()]);
528		$new_pos->ZIP     ($_->[PLZ::LOOK_ZIP     ()]);
529		push @$choices_o, $new_pos;
530		last if defined $limit && @$choices_o >= $limit;
531	    }
532	    return undef;
533	}
534
535	my $from_data = $from_res[0]->[0];
536	$pos_o->Street  ($from_data->[PLZ::LOOK_NAME    ()]);
537	$pos_o->Citypart($from_data->[PLZ::LOOK_CITYPART()]);
538	$pos_o->Coord   ($from_data->[PLZ::LOOK_COORD   ()]);
539	$pos_o->ZIP     ($from_data->[PLZ::LOOK_ZIP     ()]);
540
541	if ($context->ChooseExactCrossing) {
542	    $self->init_str;
543	    my(@r) = $self->Streets->get_by_strname_and_citypart($pos_o->Street, $pos_o->Citypart);
544	    if (!@r) {
545		if ($context->Verbose) {
546		    warn "Found street <" . $pos_o->Street . "> from ZIP file, but not in streets file. Using nevertheless";
547		}
548	    } else {
549		$self->create_exact_crossing_choices(\@r, $pos_o, $choices_o, $type);
550		if (@$choices_o > 1) {
551		    return undef;
552		}
553		# else: we have only one position
554	    }
555	}
556    } elsif (defined $street) {
557	$self->init_str; # for $self->Streets
558	# rx or not?
559	my $r = $self->Streets->get_by_name("^(?i:" . quotemeta($street) . ".*)", 1);
560	if (!$r) {
561	    die "Can't find $street in file @{[ $self->Streets->file ]}";
562	}
563	require Strassen::Strasse;
564	my($strname, $citypart) = Strasse::split_street_citypart($r->[Strassen::NAME()]);
565	$pos_o->Street($strname);
566	$pos_o->Citypart($citypart);
567	if ($context->ChooseExactCrossing) {
568	    $self->create_exact_crossing_choices([$r], $pos_o, $choices_o, $type);
569	    if (@$choices_o > 1) {
570		return undef;
571	    }
572	    # else: we have only one position
573	}
574	my $coords = $r->[Strassen::COORDS()];
575	$pos_o->Coord($coords->[$#$coords/2]); # use middle of street
576    }
577
578    if ($fixposition) {
579	$self->fix_position($pos_o);
580    }
581    $pos_o->Coord;
582}
583
584sub get_position {
585    my $self = shift;
586    my $type = ucfirst(shift); # start or goal
587    my(%args) = @_;
588    my $pos_o = $self->$type();
589    my $choices = $type . "Choices";
590    my $choices_o = $self->$choices();
591    $args{type} = $type;
592    $self->resolve_position($pos_o, $choices_o, undef, undef, %args);
593}
594
595sub fix_position {
596    my($self, $pos_o) = @_;
597    $self->init_net;
598    if (!$self->Net->reachable($pos_o->Coord)) {
599	$self->init_crossings;
600	$pos_o->Coord($self->Crossings->nearest_loop(split(/,/, $pos_o->Coord), BestOnly => 1, UseCache => $self->Context->UseCache));
601	if ($self->Context->Vehicle eq 'oepnv') {
602	    $self->init_crossings; # XXX �berfl�ssig?
603	    $pos_o->Street($self->Crossings->get_first($pos_o->Coord));
604	}
605    }
606    $pos_o->Coord;
607}
608
609sub create_exact_crossing_choices {
610    my($self, $r_array, $pos_o, $choices_o, $type) = @_;
611
612    require Strassen::Strasse;
613
614    @$choices_o = ();
615    my $crossings = $self->init_crossings;
616    for my $r (@$r_array) {
617	for my $c (@{ $r->[Strassen::COORDS()] }) {
618	    if ($crossings->crossing_exists($c)) {
619		my @crossing_records = grep { (Strasse::split_street_citypart($_->[Strassen::NAME()]))[0] ne $pos_o->Street } @{ $crossings->get_records($c) };
620		next if !@crossing_records;
621		my $catref = $self->init_str->default_cat_stack_mapping;
622		@crossing_records = sort { $catref->{$b->[Strassen::CAT()]} <=> $catref->{$a->[Strassen::CAT()]} } @crossing_records;
623		my @crossing_streets = map { (Strasse::split_street_citypart($_->[Strassen::NAME()]))[0] } @crossing_records;
624		my $new_pos = $self->BBBikeRouting_Position_Class->new;
625		$new_pos->Street(join("/", @crossing_streets));
626		$new_pos->Coord($c);
627		push @$choices_o, $new_pos;
628	    }
629	}
630    }
631    if (@$choices_o > 1) {
632	my $member = $type . "ChoicesIsCrossings";
633	$self->$member(1);
634    }
635}
636
637sub search {
638    my($self) = @_;
639
640    $self->init_net;
641
642    my $continued = 0;
643    my $start_coord;
644    if (ref $self->Via eq 'ARRAY' && @{$self->Via} > 0) {
645	$self->get_position("LastVia") if $self->LastVia && !$self->LastVia->Coord;
646	$start_coord = $self->LastVia->Coord;
647	$continued = 1;
648    } else {
649	$self->get_position("Start") if !$self->Start->Coord;
650	$start_coord = $self->Start->Coord;
651    }
652    $self->get_position("Goal") if !$self->Goal->Coord;
653
654    my $die;
655    if (!$start_coord) {
656	if ($self->StartChoices && @{ $self->StartChoices }) {
657	    warn "Multiple start choices found: " .
658		join(", ", map { $_->Street . "/" . $_->Citypart } @{ $self->StartChoices }) .
659		    ", please resolve by using StartChoices\n";
660	} else {
661	    warn "No start coordinate found for " .
662		$self->Start->Street . "/" . $self->Start->Citypart .
663		    " after using get_position\n";
664	}
665	$die++;
666    }
667
668    if (!$self->Goal->Coord) {
669	if ($self->GoalChoices && @{ $self->GoalChoices }) {
670	    warn "Multiple goal choices found: " .
671		join(", ", map { $_->Street . "/" . $_->Citypart } @{ $self->GoalChoices }) .
672		    ", please resolve by using GoalChoices\n";
673	} else {
674	    warn "No goal coordinate found for " .
675		$self->Goal->Street . "/" . $self->Goal->Citypart .
676		    " after using get_position\n";
677	}
678	$die++;
679    }
680
681    if ($die) {
682	die "No start and/or goal found, aborting";
683    }
684
685    my $context = $self->Context;
686
687    if (defined $context->Verbose && $context->Verbose > 1) {
688	Strassen::set_verbose(1);
689    }
690    my @search_args =
691	(
692	 Tragen => ($context->Vehicle eq 'bike'),
693	 $context->Velocity ? (Velocity => $context->Velocity) : (),
694	 $context->SearchArgs ? @{ $context->SearchArgs } : (),
695	 $context->Algorithm ? (Algorithm => $context->Algorithm) : (),
696	 $context->Verbose ? (Stat => 1) : (),
697	);
698    my($res) = $self->Net->search
699	($start_coord, $self->Goal->Coord, @search_args);
700    if (!$res) {
701	die "No route found between $start_coord and " . $self->Goal->Coord . "\nusing search arguments: @search_args\n";
702    }
703
704    if ($continued && $self->Path) {
705	my $path_index_start = 0;
706	if (defined $res) {
707	    $path_index_start = @{ $self->Path };
708	    $self->Path([@{ $self->Path },
709			 @{ $res }]);
710	}
711	my @new_route_info = $self->Net->route_info(Route => $res,
712						    Km    => $context->RouteInfoKm,
713						    PathIndexStart => $path_index_start,
714						    StartMeters => $self->RouteInfo->[-1]->{WholeMeters},
715						   );
716	$self->RouteInfo([@{ $self->RouteInfo }, @new_route_info ]);
717    } else {
718	$self->Path([]);
719	if (defined $res) {
720	    $self->Path($res);
721	}
722	$self->RouteInfo([$self->Net->route_info(Route => $self->Path,
723						 Km    => $context->RouteInfoKm)]);
724    }
725}
726
727# Prepare for a continued search. Call ->search after this method.
728sub continue {
729    my($self, $position) = @_;
730    $self->Via([]) if ref $self->Via ne 'ARRAY';
731    push @{ $self->Via }, $self->Goal;
732    $self->Goal($position);
733}
734
735# Add a new point _without a search_ to an existing route. If there
736# is no existing route, set the point as start point. The software
737# using BBBikeRouting.pm should take care that there is no search
738# from or to a freely added position.
739sub add_position {
740    my($self, $position, %args) = @_;
741    my $is_start = 0;
742    if (!$self->Path || scalar @{$self->Path} == 0) {
743	$is_start = 1;
744	$self->RouteInfo([]);
745	$self->Path([]);
746    }
747    $position->Attribs("free"); # XXX preserve existing attributes?
748    if (!$is_start) {
749	$self->Via([]) if ref $self->Via ne 'ARRAY';
750	push @{ $self->Via }, $self->Goal;
751	$self->Goal($position);
752    } else {
753	$self->Start($position);
754    }
755    push @{ $self->Path }, [split /,/, $position->Coord];
756    if (!$is_start) {
757	require Strassen::Util;
758	require BBBikeUtil;
759	my $hop = Strassen::Util::strecke(@{$self->Path}[-2,-1]);
760	my $whole_meters = ($self->RouteInfo->[-1] ? $self->RouteInfo->[-1]->{WholeMeters} : 0) + $hop;
761	my $whole = BBBikeUtil::m2km($whole_meters) . " km";
762	push @{ $self->RouteInfo },
763	    {Hop => BBBikeUtil::m2km($hop),
764	     Whole => $whole,
765	     WholeMeters => $whole_meters,
766	     Way => "", # XXX
767	     Angle => "", # XXX
768	     Direction => "", # XXX
769	     Street => "???",
770	     Coords => join(",",@{$self->Path->[-2]}),
771	    };
772    }
773}
774
775sub delete_to_last_via {
776    my($self) = @_;
777    if (ref $self->Via eq 'ARRAY' && @{$self->Via} > 0) {
778	my $via = pop @{$self->Via};
779	while(@{$self->Path}) {
780	    my $last = pop @{$self->Path};
781	    last if (join(",", @$last) eq $via->Coord);
782	}
783	if (@{$self->Path}) {
784	    my $new_goal = $self->BBBikeRouting_Position_Class->new;
785	    $new_goal->Coord(join(",", @{ $self->Path->[-1] }));
786	    $self->Goal($new_goal);
787	}
788	$self->RouteInfo([$self->Net->route_info(Route => $self->Path,
789						 Km    => $self->Context->RouteInfoKm)]);
790    }
791}
792
793sub inc {
794    eval <<'EOF';
795use FindBin;
796use lib ("$FindBin::RealBin",
797	 "$FindBin::RealBin/lib",
798	 "$FindBin::RealBin/data",
799	 "$FindBin::RealBin/..",
800	 "$FindBin::RealBin/../lib",
801	 "$FindBin::RealBin/../data",
802	);
803EOF
804    warn $@ if $@;
805}
806
807sub path_to_bbd {
808    my($self, %args) = @_;
809    my $name = $args{name};
810    $name = "Route" if !defined $name;
811    my $cat  = $args{cat};
812    $cat  = "X"     if !defined $cat;
813    "$name\t$cat " . join(" ", map { join ",", @$_ } @{ $self->Path }) . "\n";
814}
815
8161;
817
818__END__
819
820