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