store description and sections in wagon group

3 files changed, 68 insertions, 33 deletions

diff --git a/bin/db-wagenreihung b/bin/db-wagenreihung
index c1daac1..0f13c54 100755
--- a/bin/db-wagenreihung
+++ b/bin/db-wagenreihung
@@ -149,22 +149,30 @@ for my $wagon ( $wr->wagons ) {
 print $wr->direction == 100 ? '>' : '<';
 print "\n\n";
 
-for my $desc ( $wr->train_descriptions ) {
-	if ( $desc->{text} ) {
+for my $group ( $wr->groups ) {
+	if ( $group->has_sections ) {
 		printf( "%s (%s)\n",
-			$desc->{text}, join( q{}, @{ $desc->{sections} } ) );
+			$group->description || 'Zug',
+			join( q{}, $group->sections ) );
+	}
+	else {
+		say $group->description || 'Zug';
 	}
-}
-
-say "";
-
-for my $wagon ( $wr->wagons ) {
 	printf(
-		"%3s: %3s %10s  %s\n",
-		$wagon->is_closed ? 'X' : ( $wagon->number || '?' ),
-		$wagon->model || '???',
-		$wagon->type, join( q{  }, $wagon->attributes )
+		"%s %s  %s → %s\n\n",
+		$wr->train_type, $group->train_no,
+		$group->origin,  $group->destination
 	);
+
+	for my $wagon ( $group->wagons ) {
+		printf(
+			"%3s: %3s %10s  %s\n",
+			$wagon->is_closed ? 'X' : ( $wagon->number || '?' ),
+			$wagon->model || '???',
+			$wagon->type, join( q{  }, $wagon->attributes )
+		);
+	}
+	say "";
 }
 
 __END__
diff --git a/lib/Travel/Status/DE/DBWagenreihung.pm b/lib/Travel/Status/DE/DBWagenreihung.pm
index ea14ec9..6c33971 100644
--- a/lib/Travel/Status/DE/DBWagenreihung.pm
+++ b/lib/Travel/Status/DE/DBWagenreihung.pm
@@ -261,6 +261,29 @@ sub wagongroup_powertype {
 	return $likelihood[0];
 }
 
+sub parse_train_descriptions {
+	my ($self) = @_;
+
+	for my $group ( @{ $self->{wagongroups} } ) {
+		my ( $short, $desc ) = $self->wagongroup_description( $group->wagons );
+		my @sections = uniq map { $_->section } $group->wagons;
+
+		if ( @sections and length( join( q{}, @sections ) ) ) {
+			$group->set_sections(@sections);
+		}
+		$group->set_description( $desc, $short );
+
+		push(
+			@{ $self->{train_descriptions} },
+			{
+				sections => [@sections],
+				short    => $short,
+				text     => $desc,
+			}
+		);
+	}
+}
+
 sub parse_wagonorder {
 	my ($self) = @_;
 
@@ -276,6 +299,7 @@ sub parse_wagonorder {
 	$self->{train_no}   = $self->{data}{istformation}{zugnummer};
 
 	$self->parse_wagons;
+	$self->parse_train_descriptions;
 	$self->{origins}      = $self->parse_wings('startbetriebsstellename');
 	$self->{destinations} = $self->parse_wings('zielbetriebsstellename');
 }
@@ -406,26 +430,7 @@ sub sections {
 
 sub train_descriptions {
 	my ($self) = @_;
-
-	if ( exists $self->{train_descriptions} ) {
-		return @{ $self->{train_descriptions} };
-	}
-
-	for my $group ( @{ $self->{wagongroups} } ) {
-		my ( $short, $desc ) = $self->wagongroup_description( $group->wagons );
-		my @sections = uniq map { $_->section } $group->wagons;
-
-		push(
-			@{ $self->{train_descriptions} },
-			{
-				sections => [@sections],
-				short    => $short,
-				text     => $desc,
-			}
-		);
-	}
-
-	return @{ $self->{train_descriptions} };
+	return @{ $self->{train_descriptions} // [] };
 }
 
 sub train_numbers {
diff --git a/lib/Travel/Status/DE/DBWagenreihung/Group.pm b/lib/Travel/Status/DE/DBWagenreihung/Group.pm
index 76fc159..a627b6e 100644
--- a/lib/Travel/Status/DE/DBWagenreihung/Group.pm
+++ b/lib/Travel/Status/DE/DBWagenreihung/Group.pm
@@ -10,7 +10,8 @@ use parent 'Class::Accessor';
 our $VERSION = '0.13';
 
 Travel::Status::DE::DBWagenreihung::Group->mk_ro_accessors(
-	qw(id train_no type origin destination));
+	qw(id train_no type description desc_short origin destination has_sections)
+);
 
 sub new {
 	my ( $obj, %opt ) = @_;
@@ -19,6 +20,21 @@ sub new {
 	return bless( $ref, $obj );
 }
 
+sub set_description {
+	my ( $self, $desc, $short ) = @_;
+
+	$self->{description} = $desc;
+	$self->{desc_short}  = $short;
+}
+
+sub set_sections {
+	my ( $self, @sections ) = @_;
+
+	$self->{sections} = [@sections];
+
+	$self->{has_sections} = 1;
+}
+
 sub set_traintype {
 	my ( $self, $i, $tt ) = @_;
 	$self->{type} = $tt;
@@ -35,6 +51,12 @@ sub sort_wagons {
 	  @{ $self->{wagons} };
 }
 
+sub sections {
+	my ($self) = @_;
+
+	return @{ $self->{sections} // [] };
+}
+
 sub wagons {
 	my ($self) = @_;