From b066c8145dfb091f073d91ca1ed043847d0c390b Mon Sep 17 00:00:00 2001
From: Daniel Friesel <derf@finalrewind.org>
Date: Thu, 27 Dec 2018 15:25:27 +0100
Subject: add some type parsing

---
 lib/Travel/Status/DE/DBWagenreihung/Wagon.pm | 67 +++++++++++++++++++++++++++-
 1 file changed, 65 insertions(+), 2 deletions(-)

(limited to 'lib')

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 {
-- 
cgit v1.2.3