From 743ac36d89c8c768fd6b895e63865b7384e3898b Mon Sep 17 00:00:00 2001
From: Birte Kristina Friesel <derf@finalrewind.org>
Date: Sat, 27 Apr 2024 11:13:08 +0200
Subject: DBWagenreihung: sort functions by visibility

---
 lib/Travel/Status/DE/DBWagenreihung.pm | 347 +++++++++++++++++----------------
 1 file changed, 180 insertions(+), 167 deletions(-)

(limited to 'lib/Travel/Status/DE/DBWagenreihung.pm')

diff --git a/lib/Travel/Status/DE/DBWagenreihung.pm b/lib/Travel/Status/DE/DBWagenreihung.pm
index ae65f22..03c0466 100644
--- a/lib/Travel/Status/DE/DBWagenreihung.pm
+++ b/lib/Travel/Status/DE/DBWagenreihung.pm
@@ -19,6 +19,8 @@ our $VERSION = '0.12';
 Travel::Status::DE::DBWagenreihung->mk_ro_accessors(
 	qw(direction platform station train_no train_type));
 
+# {{{ Rolling Stock Models
+
 my %is_redesign = (
 	"02" => 1,
 	"03" => 1,
@@ -103,6 +105,9 @@ my %power_desc = (
 	99 => 'Sonderfahrzeug',
 );
 
+# }}}
+# {{{ Constructors
+
 sub new {
 	my ( $class, %opt ) = @_;
 
@@ -184,69 +189,94 @@ sub get_wagonorder {
 	return $self->parse_wagonorder;
 }
 
-sub parse_wagonorder {
-	my ($self) = @_;
+# }}}
+# {{{ Internal Helpers
 
-	$self->{platform} = $self->{data}{istformation}{halt}{gleisbezeichnung};
+sub get_with_cache {
+	my ( $self, $cache, $url ) = @_;
 
-	$self->{station} = {
-		ds100 => $self->{data}{istformation}{halt}{rl100},
-		eva   => $self->{data}{istformation}{halt}{evanummer},
-		name  => $self->{data}{istformation}{halt}{bahnhofsname},
-	};
+	if ( $self->{developer_mode} ) {
+		say "GET $url";
+	}
 
-	$self->{train_type} = $self->{data}{istformation}{zuggattung};
-	$self->{train_no}   = $self->{data}{istformation}{zugnummer};
+	if ($cache) {
+		my $content = $cache->thaw($url);
+		if ($content) {
+			if ( $self->{developer_mode} ) {
+				say '  cache hit';
+			}
+			return ( ${$content}, undef );
+		}
+	}
 
-	$self->parse_wagons;
-	$self->{origins}      = $self->parse_wings('startbetriebsstellename');
-	$self->{destinations} = $self->parse_wings('zielbetriebsstellename');
-}
+	if ( $self->{developer_mode} ) {
+		say '  cache miss';
+	}
 
-sub errstr {
-	my ($self) = @_;
+	my $ua  = $self->{user_agent};
+	my $res = $ua->get($url);
 
-	return $self->{errstr};
+	if ( $res->is_error ) {
+		return ( undef, $res->status_line );
+	}
+	my $content = $res->decoded_content;
+
+	if ($cache) {
+		$cache->freeze( $url, \$content );
+	}
+
+	return ( $content, undef );
 }
 
-sub TO_JSON {
-	my ($self) = @_;
+sub wagongroup_powertype {
+	my ( $self, @wagons ) = @_;
 
-	# ensure that all objects are available
-	$self->origins;
-	$self->destinations;
-	$self->train_numbers;
-	$self->train_descriptions;
-	$self->sections;
+	if ( not @wagons ) {
+		@wagons = $self->wagons;
+	}
 
-	my %copy = %{$self};
+	my %ml = map { $_ => 0 } ( 90 .. 99 );
 
-	delete $copy{from_json};
+	for my $wagon (@wagons) {
 
-	return {%copy};
-}
+		if ( not $wagon->uic_id or length( $wagon->uic_id ) != 12 ) {
+			next;
+		}
 
-sub has_bad_wagons {
-	my ($self) = @_;
+		my $wagon_type = substr( $wagon->uic_id, 0, 2 );
+		if ( $wagon_type < 90 ) {
+			next;
+		}
 
-	if ( defined $self->{has_bad_wagons} ) {
-		return $self->{has_bad_wagons};
+		$ml{$wagon_type}++;
 	}
 
-	for my $group ( @{ $self->{data}{istformation}{allFahrzeuggruppe} } ) {
-		for my $wagon ( @{ $group->{allFahrzeug} } ) {
-			my $pos = $wagon->{positionamhalt};
-			if (   $pos->{startprozent} eq ''
-				or $pos->{endeprozent} eq ''
-				or $pos->{startmeter} eq ''
-				or $pos->{endemeter} eq '' )
-			{
-				return $self->{has_bad_wagons} = 1;
-			}
-		}
+	my @likelihood = reverse sort { $ml{$a} <=> $ml{$b} } keys %ml;
+
+	if ( $ml{ $likelihood[0] } == 0 ) {
+		return undef;
 	}
 
-	return $self->{has_bad_wagons} = 0;
+	return $likelihood[0];
+}
+
+sub parse_wagonorder {
+	my ($self) = @_;
+
+	$self->{platform} = $self->{data}{istformation}{halt}{gleisbezeichnung};
+
+	$self->{station} = {
+		ds100 => $self->{data}{istformation}{halt}{rl100},
+		eva   => $self->{data}{istformation}{halt}{evanummer},
+		name  => $self->{data}{istformation}{halt}{bahnhofsname},
+	};
+
+	$self->{train_type} = $self->{data}{istformation}{zuggattung};
+	$self->{train_no}   = $self->{data}{istformation}{zugnummer};
+
+	$self->parse_wagons;
+	$self->{origins}      = $self->parse_wings('startbetriebsstellename');
+	$self->{destinations} = $self->parse_wings('zielbetriebsstellename');
 }
 
 sub parse_wings {
@@ -270,6 +300,63 @@ sub parse_wings {
 	return \@names;
 }
 
+sub parse_wagons {
+	my ($self) = @_;
+
+	my @wagon_groups;
+
+	for my $group ( @{ $self->{data}{istformation}{allFahrzeuggruppe} } ) {
+		my @group;
+		for my $wagon ( @{ $group->{allFahrzeug} } ) {
+			my $wagon_object
+			  = Travel::Status::DE::DBWagenreihung::Wagon->new( %{$wagon},
+				train_no => $group->{verkehrlichezugnummer} );
+			push( @{ $self->{wagons} }, $wagon_object );
+			push( @group,               $wagon_object );
+			if ( not $wagon_object->{position}{valid} ) {
+				$self->{has_bad_wagons} = 1;
+			}
+		}
+		push( @wagon_groups, [@group] );
+	}
+	if ( @{ $self->{wagons} // [] } > 1 and not $self->has_bad_wagons ) {
+		if ( $self->{wagons}[0]->{position}{start_percent}
+			> $self->{wagons}[-1]->{position}{start_percent} )
+		{
+			$self->{direction} = 100;
+		}
+		else {
+			$self->{direction} = 0;
+		}
+	}
+	if ( not $self->has_bad_wagons ) {
+		@{ $self->{wagons} } = sort {
+			$a->{position}->{start_percent} <=> $b->{position}->{start_percent}
+		} @{ $self->{wagons} };
+	}
+
+	for my $i ( 0 .. $#wagon_groups ) {
+		my $group = $wagon_groups[$i];
+		my $tt    = $self->wagongroup_subtype( @{$group} );
+		if ($tt) {
+			for my $wagon ( @{$group} ) {
+				$wagon->set_traintype( $i, $tt );
+			}
+		}
+	}
+
+	$self->{wagongroups} = [@wagon_groups];
+}
+
+# }}}
+# {{{ Public Functions
+
+sub errstr {
+	my ($self) = @_;
+
+	return $self->{errstr};
+}
+
 sub destinations {
 	my ($self) = @_;
 
@@ -309,6 +396,30 @@ sub sections {
 	return @{ $self->{sections} // [] };
 }
 
+sub train_descriptions {
+	my ($self) = @_;
+
+	if ( exists $self->{train_descriptions} ) {
+		return @{ $self->{train_descriptions} };
+	}
+
+	for my $wagons ( @{ $self->{wagongroups} } ) {
+		my ( $short, $desc ) = $self->wagongroup_description( @{$wagons} );
+		my @sections = uniq map { $_->section } @{$wagons};
+
+		push(
+			@{ $self->{train_descriptions} },
+			{
+				sections => [@sections],
+				short    => $short,
+				text     => $desc,
+			}
+		);
+	}
+
+	return @{ $self->{train_descriptions} };
+}
+
 sub train_numbers {
 	my ($self) = @_;
 
@@ -329,60 +440,27 @@ sub train_numbers {
 	return @numbers;
 }
 
-sub wagongroup_powertype {
-	my ( $self, @wagons ) = @_;
-
-	if ( not @wagons ) {
-		@wagons = $self->wagons;
-	}
-
-	my %ml = map { $_ => 0 } ( 90 .. 99 );
-
-	for my $wagon (@wagons) {
-
-		if ( not $wagon->uic_id or length( $wagon->uic_id ) != 12 ) {
-			next;
-		}
-
-		my $wagon_type = substr( $wagon->uic_id, 0, 2 );
-		if ( $wagon_type < 90 ) {
-			next;
-		}
-
-		$ml{$wagon_type}++;
-	}
-
-	my @likelihood = reverse sort { $ml{$a} <=> $ml{$b} } keys %ml;
-
-	if ( $ml{ $likelihood[0] } == 0 ) {
-		return undef;
-	}
-
-	return $likelihood[0];
-}
-
-sub train_descriptions {
+sub has_bad_wagons {
 	my ($self) = @_;
 
-	if ( exists $self->{train_descriptions} ) {
-		return @{ $self->{train_descriptions} };
+	if ( defined $self->{has_bad_wagons} ) {
+		return $self->{has_bad_wagons};
 	}
 
-	for my $wagons ( @{ $self->{wagongroups} } ) {
-		my ( $short, $desc ) = $self->wagongroup_description( @{$wagons} );
-		my @sections = uniq map { $_->section } @{$wagons};
-
-		push(
-			@{ $self->{train_descriptions} },
+	for my $group ( @{ $self->{data}{istformation}{allFahrzeuggruppe} } ) {
+		for my $wagon ( @{ $group->{allFahrzeug} } ) {
+			my $pos = $wagon->{positionamhalt};
+			if (   $pos->{startprozent} eq ''
+				or $pos->{endeprozent} eq ''
+				or $pos->{startmeter} eq ''
+				or $pos->{endemeter} eq '' )
 			{
-				sections => [@sections],
-				short    => $short,
-				text     => $desc,
+				return $self->{has_bad_wagons} = 1;
 			}
-		);
+		}
 	}
 
-	return @{ $self->{train_descriptions} };
+	return $self->{has_bad_wagons} = 0;
 }
 
 sub wagongroup_description {
@@ -635,89 +713,24 @@ sub wagons {
 	return @{ $self->{wagons} // [] };
 }
 
-sub parse_wagons {
+sub TO_JSON {
 	my ($self) = @_;
 
-	my @wagon_groups;
+	# ensure that all objects are available
+	$self->origins;
+	$self->destinations;
+	$self->train_numbers;
+	$self->train_descriptions;
+	$self->sections;
 
-	for my $group ( @{ $self->{data}{istformation}{allFahrzeuggruppe} } ) {
-		my @group;
-		for my $wagon ( @{ $group->{allFahrzeug} } ) {
-			my $wagon_object
-			  = Travel::Status::DE::DBWagenreihung::Wagon->new( %{$wagon},
-				train_no => $group->{verkehrlichezugnummer} );
-			push( @{ $self->{wagons} }, $wagon_object );
-			push( @group,               $wagon_object );
-			if ( not $wagon_object->{position}{valid} ) {
-				$self->{has_bad_wagons} = 1;
-			}
-		}
-		push( @wagon_groups, [@group] );
-	}
-	if ( @{ $self->{wagons} // [] } > 1 and not $self->has_bad_wagons ) {
-		if ( $self->{wagons}[0]->{position}{start_percent}
-			> $self->{wagons}[-1]->{position}{start_percent} )
-		{
-			$self->{direction} = 100;
-		}
-		else {
-			$self->{direction} = 0;
-		}
-	}
-	if ( not $self->has_bad_wagons ) {
-		@{ $self->{wagons} } = sort {
-			$a->{position}->{start_percent} <=> $b->{position}->{start_percent}
-		} @{ $self->{wagons} };
-	}
+	my %copy = %{$self};
 
-	for my $i ( 0 .. $#wagon_groups ) {
-		my $group = $wagon_groups[$i];
-		my $tt    = $self->wagongroup_subtype( @{$group} );
-		if ($tt) {
-			for my $wagon ( @{$group} ) {
-				$wagon->set_traintype( $i, $tt );
-			}
-		}
-	}
+	delete $copy{from_json};
 
-	$self->{wagongroups} = [@wagon_groups];
+	return {%copy};
 }
 
-sub get_with_cache {
-	my ( $self, $cache, $url ) = @_;
-
-	if ( $self->{developer_mode} ) {
-		say "GET $url";
-	}
-
-	if ($cache) {
-		my $content = $cache->thaw($url);
-		if ($content) {
-			if ( $self->{developer_mode} ) {
-				say '  cache hit';
-			}
-			return ( ${$content}, undef );
-		}
-	}
-
-	if ( $self->{developer_mode} ) {
-		say '  cache miss';
-	}
-
-	my $ua  = $self->{user_agent};
-	my $res = $ua->get($url);
-
-	if ( $res->is_error ) {
-		return ( undef, $res->status_line );
-	}
-	my $content = $res->decoded_content;
-
-	if ($cache) {
-		$cache->freeze( $url, \$content );
-	}
-
-	return ( $content, undef );
-}
+# }}}
 
 1;
 
-- 
cgit v1.2.3