diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Travel/Status/DE/DBWagenreihung/Wagon.pm | 67 |
1 files changed, 65 insertions, 2 deletions
diff --git a/lib/Travel/Status/DE/DBWagenreihung/Wagon.pm b/lib/Travel/Status/DE/DBWagenreihung/Wagon.pm index 850bc84..0f92500 100644 --- a/lib/Travel/Status/DE/DBWagenreihung/Wagon.pm +++ b/lib/Travel/Status/DE/DBWagenreihung/Wagon.pm @@ -11,7 +11,9 @@ use Carp qw(cluck); our $VERSION = '0.00'; Travel::Status::DE::DBWagenreihung::Wagon->mk_ro_accessors( - qw(class_type has_bistro is_locomotive is_powercar number section)); + qw(attributes class_type has_ac has_accessibility has_bistro + has_multipurpose is_dosto is_interregio is_locomotive is_powercar number + section type)); sub new { my ( $obj, %opt ) = @_; @@ -25,6 +27,10 @@ sub new { $ref->{section} = $opt{fahrzeugsektor}; $ref->{type} = $opt{fahrzeugtyp}; + my $self = bless($ref, $obj); + + $self->parse_type; + if ( $opt{kategorie} =~ m{SPEISEWAGEN} ) { $ref->{has_bistro} = 1; } @@ -52,7 +58,64 @@ sub new { $ref->{position}{start_meters} = $pos->{startmeter}; $ref->{position}{end_meters} = $pos->{endemeter}; - return bless( $ref, $obj ); + return $self; +} + +sub attributes { + my ($self) = @_; + + return @{$self->{attributes} // []}; +} + +sub parse_type { + my ($self) = @_; + + my $type = $self->{type}; + my @desc; + + # Thanks to <https://www.deutsche-reisezugwagen.de/lexikon/erklarung-der-gattungszeichen/> + + if ($type =~ m{^D}) { + $self->{is_dosto} = 1; + push(@desc, 'Doppelstock'); + } + + if ($type =~ m{b}) { + $self->{has_accessibility} = 1; + push(@desc, 'Behindertengerechte Ausstattung'); + } + + if ($type =~ m{d}) { + $self->{has_multipurpose} = 1; + push(@desc, 'Mehrzweckraum'); + } + + if ($type =~ m{f}) { + push(@desc, 'Steuerabteil'); + } + + if ($type =~ m{i}) { + $self->{is_interregio} = 1; + push(@desc, 'Interregiowagen'); + } + + if ($type =~ m{m}) { + # ? + } + + if ($type =~ m{p}) { + $self->{has_ac} = 1; + push(@desc, 'klimatisiert'); + push(@desc, 'Großraum'); + } + + if ($type =~ m{v}) { + $self->{has_ac} = 1; + push(@desc, 'klimatisiert'); + push(@desc, 'Abteilwagen'); + } + + $self->{attributes} = \@desc; } sub is_first_class { |