From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

GWS / Map-Tube-Brussels-v0.1.0 / lib / Map / Tube / Brussels.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
—
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
—
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

              
# -*- perl -*-
#
# Author: Gisbert W. Selke, TapirSoft Selke & Selke GbR.
#
# Copyright (C) 2025 Gisbert W. Selke. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: gws@cpan.org
#
package Map::Tube::Brussels;
use 5.12.0;
use version 0.77 ( );
use strict;
use warnings;
our $VERSION = version->declare('v0.1.0');
=encoding utf8
=head1 NAME
Map::Tube::Brussels - Interface to the Brussels tube map
=cut
use File::Share ':all';
use Moo;
use namespace::clean;
my %nametypes = map { $_ => 1 } qw(alt); # The permissible alternative nametypes. In our case, just 'alt'
has xml          => ( is  => 'ro', lazy => 1, default => sub { return dist_file('Map-Tube-Brussels', 'brussels-map.xml') } );
has nametype => ( is  => 'ro', default => '',
                                  isa => sub { die __PACKAGE__ . ": ERROR: Invalid nametype for constructor: '$_[0]'" unless ( ( $_[0] eq '') || exists($nametypes{ $_[0] } ) ) },
                );
with 'Map::Tube';
before _validate_map_structure => sub {
  $_[1] = _relocate_alternatives( $_[1], '_' . $_[0]->{nametype} ) if ( exists( $_[0]->{nametype}) && ( $_[0]->{nametype} ne '' ) );
  $_[1] = _remove_alternatives( $_[1] );
};
sub _relocate_alternatives {
  my( $branch, $suffix ) = @_;
  for my $key( keys %{ $branch } ) {
    if ( ref( $branch->{$key} ) eq 'HASH' ) {
          $branch->{$key} = _relocate_alternatives( $branch->{$key}, $suffix );
    } elsif ( ( ref( $branch->{$key} ) eq '' ) && ( $key eq ( 'name' . $suffix ) ) ) {
      $branch->{'name'} = $branch->{ 'name' . $suffix };
    } elsif ( ref( $branch->{$key} ) eq 'ARRAY' ) {
          $branch->{$key} = [ map { _relocate_alternatives( $_, $suffix ) } @{ $branch->{$key} } ];
    }
  }
  return $branch;
}
sub _remove_alternatives {
  my($branch) = @_;
  for my $key( keys %{ $branch } ) {
    if ( ref( $branch->{$key} ) eq 'HASH' ) {
          $branch->{$key} = _remove_alternatives( $branch->{$key} );
        } elsif ( ( ref( $branch->{$key} ) eq '' ) && ( $key eq 'name' ) ) {
          for my $suffix ( keys(%nametypes) ) {
                delete $branch->{ $key . '_' . $suffix };
          }
    } elsif ( ref( $branch->{$key} ) eq 'ARRAY' ) {
          $branch->{$key} = [ map { _remove_alternatives($_) } @{ $branch->{$key} } ];
        }
  }
  return $branch;
}
=head1 SYNOPSIS
        use Map::Tube::Brussels;
        my $tube_nl  = Map::Tube::Brussels->new( nametype => 'alt' );
        my $route_nl = $tube_nl->get_shortest_route('Delacroix', 'Zuidstation')->preferred( );
        print "Route: $route_nl\n";
        my $tube_fr  = Map::Tube::Brussels->new( );
        my $route_fr = $tube_fr->get_shortest_route('Delacroix', 'Gare du Midi')->preferred( );
        print "Route: $route_fr\n";
=head1 DESCRIPTION
This module allows to find the shortest route between any two given tube
stations in Brussels. All interesting methods are provided by the role
L<Map::Tube>.
=head1 METHODS
=head2 CONSTRUCTOR
        use Map::Tube::Brussels;
        my $tube_fr = Map::Tube::Brussels->new( );
        my $tube_nl = Map::Tube::Brussels->new( nametype => 'alt' );
This will read the tube information from the shared file
F<brussels-map.xml>, which is part of the distribution.  Without
argument, French-language place names will be used.  With the value
C<'alt>' for C<nametype>, Dutch-language place names will be used.
Other values will throw an error.
=head1 METHODS
=head2 nametype( )
This yields the nametype that was specified with the constructor call, or '' if none.
=head1 MAP DATA FORMAT
The data format for Map::Tube instances is described in the
documentation for L<Map::Tube>.  The Brussels map, however, comes either
with station and line names in the French language (spoken in Wallonia)
or in the Dutch language (spoken in Flanders).  All line and station
tags have the French name in the C<name> attribute.  For tags where two
names differ there is an additional C<name_alt> attribute having the
Dutch name.  When reading the map data and no C<nametype> is given, all
the C<name_alt> attributes are deleted, so that the L<Map::Tube>
software sees only a standard data structure.  However, if
C<nametype=alt> was specified when instantiating L<Map::Data::Brussels>,
the C<name_alt> attributes will be copied into the C<name> atributes,
and, again, the C<name_alt> attributes themselves are removed.
=head1 ERRORS
If something goes wrong, maybe because the map information file was corrupted,
the constructor will die.
Some sources have a slightly different view on which stations exist on which lines.
While the differences are few, they should be resolved by direct evidence. Hints are
welcome.
=head1 AUTHOR
Gisbert W. Selke, TapirSoft Selke & Selke GbR.
=head1 COPYRIGHT AND LICENCE
The data for the XML file were mainly taken from the appropriate French and Dutch Wikipedia
pages. They are CC BY-SA 2.0. For additional verification and names, openstreetmap.org was
consulted.
The module itself is free software; you may redistribute and/or modify it under
the same terms as Perl itself.
=head1 SEE ALSO
L<Map::Tube>, L<Map::Tube::GraphViz>.
=cut
1;