view release on metacpan or  search on metacpan

lib/Map/Metro/Graph.pm  view on Meta::CPAN

    foreach my $conn ($self->all_connections) {
        $graph->add_weighted_edge($conn->origin_line_station->line_station_id,
                                  $conn->destination_line_station->line_station_id,
                                  $conn->weight);
    }
    return $graph;
}
sub calculate_shortest_paths { shift->full_graph->APSP_Floyd_Warshall }

sub nocase {
    my $text = shift;
    if($] >= 5.016000) {
        $text = fc $text;
    }
    else {
        $text = lc $text;
    }
    return $text;
}

sub parse {
    my $self = shift;

    $self->build_network;
    $self->construct_connections;

    return $self;
}

sub build_network {
    my $self = shift;

    my @rows = split /\r?\n/ => $self->filepath->slurp_utf8;
    my $context = undef;

    ROW:
    foreach my $row (@rows) {
        next ROW if !length $row || $row =~ m{^[ \t]*#};

        if($row =~ m{^--(\w+)} && (any { $_ eq $1 } qw/stations transfers lines segments/)) {
            $context = $1;
            next ROW;
        }

          $context eq 'stations'  ? $self->add_station($row)
        : $context eq 'transfers' ? $self->add_transfer($row)
        : $context eq 'lines'     ? $self->add_line($row)
        : $context eq 'segments'  ? $self->add_segment($row)
        :                           ()
        ;
    }
}

around add_station => sub {
    my $next = shift;
    my $self = shift;
    my $text = shift;

    $text = trim $text;
    my @names = split m{\h*%\h*} => $text;
    my $name = shift @names;

    if(my $station = $self->get_station_by_name($name, check => 0)) {
        return $station;
    }

    my $id = $self->station_count + 1;
    my $station = Map::Metro::Graph::Station->new(original_name => $name, do_undiacritic => $self->do_undiacritic, eh $name, $id);

    foreach my $another_name (@names) {
        if($another_name =~ m{^:(.+)}) {
            $station->add_search_name($1);
        }
        else {
            $station->add_alternative_name($another_name);
        }
    }
    $self->emit->before_add_station($station);
    $self->$next($station);
};

around add_transfer => sub {
    my $next = shift;
    my $self = shift;
    my $text = shift;

    $text = trim $text;

    my($origin_station_name, $destination_station_name, $option_string) = split /\|/ => $text;
    my $origin_station = $self->get_station_by_name($origin_station_name);
    my $destination_station = $self->get_station_by_name($destination_station_name);

    my $options = defined $option_string ? $self->make_options($option_string, keys => [qw/weight/]) : {};

    my $transfer = Map::Metro::Graph::Transfer->new(origin_station => $origin_station,
                                                    destination_station => $destination_station,
                                                    %$options);

    $self->$next($transfer);
};

around add_line => sub {
    my $next = shift;
    my $self = shift;
    my $text = shift;

    $text = trim $text;
    my($id, $name, $description, $option_string) = split /\|/ => $text;

    my $options = defined $option_string ? $self->make_options($option_string, keys => [qw/color width/]) : {};
    my $line = Map::Metro::Graph::Line->new(%{ $options }, id => $id, name => $name, description => $description);

    $self->$next($line);
};

around add_segment => sub {
    my $next = shift;
    my $self = shift;
    my $text = shift;

    $text = trim $text;
    my($linestring, $start, $end, $option_string) = split /\|/ => $text;
    my @line_ids_with_dir = split m/,/ => $linestring;
    my @clean_line_ids = map { (my $clean = $_) =~ s{[^a-z0-9]}{}gi; $clean } @line_ids_with_dir;

    my $options = defined $option_string ? $self->make_options($option_string, keys => [qw/dir/]) : {};

    #* Check that lines and stations in segments exist in the other lists
    my($origin_station, $destination_station);

    try {
        $self->get_line_by_id($_) foreach @clean_line_ids;
        $origin_station = $self->get_station_by_name($start);
        $destination_station = $self->get_station_by_name($end);
    }
    catch {
        die($_->$_call_if_object('desc') || $_);
    };
    my @both_dir = ();
    my @forward = ();
    my @backward = ();
    my @segments = ();

    foreach my $line_info (@line_ids_with_dir) {
        if($line_info =~ m{^[a-z0-9]+$}i) {
            push @both_dir => $line_info;
        }
        elsif($line_info =~ m{^([a-z0-9]+)->$}i) {
            push @forward => $1;
        }
        elsif($line_info =~ m{^([a-z0-9]+)<-$}i) {
            push @backward => $1;
        }
    }

    if(scalar @both_dir) {
        push @segments => Map::Metro::Graph::Segment->new(line_ids => \@both_dir, origin_station => $origin_station, destination_station => $destination_station);
    }
    if(scalar @forward) {
        push @segments => Map::Metro::Graph::Segment->new(line_ids => \@forward, is_one_way => 1, origin_station => $origin_station, destination_station => $destination_station);
    }
    if(scalar @backward) {
        push @segments => Map::Metro::Graph::Segment->new(line_ids => \@backward, is_one_way => 1, origin_station => $destination_station, destination_station => $origin_station);
    }

    $self->$next(@segments);
};

around add_line_station => sub {
    my $next = shift;
    my $self = shift;
    my $line_station = shift;

    my $exists = $self->get_line_station_by_line_and_station_id($line_station->line->id, $line_station->station->id);
    return $exists if $exists;

    $self->$next($line_station);
    return $line_station;
};

sub get_line_by_id {
    my $self = shift;
    my $line_id = shift; # Str