view release on metacpan or  search on metacpan

lib/Map/Tube/Brussels.pm  view on Meta::CPAN

# -*- 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.14.0;
use version 0.77 ( );
use strict;
use warnings;

our $VERSION = version->declare('v0.2.1');

=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.


=head2 nametype( )

This yields the nametype that was specified with the constructor call, or '' if none.


=head2 xml( )