Unverified Commit 4eb7d9c5 authored by Birte Kristina Friesel's avatar Birte Kristina Friesel
Browse files

store description and sections in wagon group

parent a0c313fc

bin/db-wagenreihung

+20 −12
Original line number Diff line number Diff line
@@ -149,16 +149,22 @@ 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';

	}

	printf(

		"%s %s  %s → %s\n\n",

		$wr->train_type, $group->train_no,

		$group->origin,  $group->destination

	);



say "";



for my $wagon ( $wr->wagons ) {

	for my $wagon ( $group->wagons ) {

		printf(

			"%3s: %3s %10s  %s\n",

			$wagon->is_closed ? 'X' : ( $wagon->number || '?' ),
@@ -166,6 +172,8 @@ for my $wagon ( $wr->wagons ) { 
			$wagon->type, join( q{  }, $wagon->attributes )

		);

	}

	say "";

}



__END__

lib/Travel/Status/DE/DBWagenreihung.pm

+25 −20
Original line number Diff line number Diff line
@@ -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 {

lib/Travel/Status/DE/DBWagenreihung/Group.pm

+23 −1
Original line number Diff line number Diff line
@@ -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) = @_;