initial commit

4 files changed, 327 insertions, 0 deletions

diff --git a/lib/Travel/Routing/DE/HAFAS/Connection.pm b/lib/Travel/Routing/DE/HAFAS/Connection.pm
new file mode 100644
index 0000000..51e6f3e
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Connection.pm
@@ -0,0 +1,147 @@
+package Travel::Routing::DE::HAFAS::Connection;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Class::Accessor';
+use DateTime::Duration;
+use Travel::Routing::DE::HAFAS::Utils;
+use Travel::Routing::DE::HAFAS::Connection::Section;
+
+our $VERSION = '0.00';
+
+Travel::Routing::DE::HAFAS::Connection->mk_ro_accessors(
+	qw(changes duration sched_dep rt_dep sched_arr rt_arr dep_datetime arr_datetime dep_platform arr_platform dep_loc arr_loc load)
+);
+
+# {{{ Constructor
+
+sub new {
+	my ( $obj, %opt ) = @_;
+
+	my $hafas      = $opt{hafas};
+	my $connection = $opt{connection};
+	my $locs       = $opt{locL};
+
+	# himL may only be present in departure monitor mode
+	my @remL = @{ $opt{common}{remL} // [] };
+	my @himL = @{ $opt{common}{himL} // [] };
+
+	my @msgL = @{ $connection->{msgL} // [] };
+	my @secL = @{ $connection->{secL} // [] };
+
+	my $date     = $connection->{date};
+	my $duration = $connection->{dur};
+
+	$duration = DateTime::Duration->new(
+		hours   => substr( $duration, 0, 2 ),
+		minutes => substr( $duration, 2, 2 ),
+		seconds => substr( $duration, 4, 2 ),
+	);
+
+	my @messages;
+	for my $msg (@msgL) {
+		if ( $msg->{type} eq 'REM' and defined $msg->{remX} ) {
+			push( @messages, $hafas->add_message( $remL[ $msg->{remX} ] ) );
+		}
+		elsif ( $msg->{type} eq 'HIM' and defined $msg->{himX} ) {
+			push( @messages, $hafas->add_message( $himL[ $msg->{himX} ], 1 ) );
+		}
+		else {
+			say "Unknown message type $msg->{type}";
+		}
+	}
+
+	my $strptime = DateTime::Format::Strptime->new(
+		pattern   => '%Y%m%dT%H%M%S',
+		time_zone => 'Europe/Berlin'
+	);
+
+	my $sched_dep = $connection->{dep}{dTimeS};
+	my $rt_dep    = $connection->{dep}{dTimeR};
+	my $sched_arr = $connection->{arr}{aTimeS};
+	my $rt_arr    = $connection->{arr}{aTimeR};
+
+	for my $ts ( $sched_dep, $rt_dep, $sched_arr, $rt_arr ) {
+		if ($ts) {
+			$ts = handle_day_change(
+				date     => $date,
+				time     => $ts,
+				strp_obj => $strptime,
+			);
+		}
+	}
+
+	my @sections;
+	for my $sec (@secL) {
+		push(
+			@sections,
+			Travel::Routing::DE::HAFAS::Connection::Section->new(
+				common => $opt{common},
+				date   => $date,
+				locL   => $locs,
+				sec    => $sec,
+				hafas  => $hafas,
+			)
+		);
+	}
+
+	my $tco = {};
+	for my $tco_id ( @{ $connection->{dTrnCmpSX}{tcocX} // [] } ) {
+		my $tco_kv = $opt{common}{tcocL}[$tco_id];
+		$tco->{ $tco_kv->{c} } = $tco_kv->{r};
+	}
+
+	my $ref = {
+		duration     => $duration,
+		changes      => $connection->{chg},
+		sched_dep    => $sched_dep,
+		rt_dep       => $rt_dep,
+		sched_arr    => $sched_arr,
+		rt_arr       => $rt_arr,
+		dep_datetime => $rt_dep // $sched_dep,
+		arr_datetime => $rt_arr // $sched_arr,
+		dep_platform => $connection->{dep}{dPlatfR}
+		  // $connection->{dep}{dPlatfS},
+		arr_platform => $connection->{arr}{aPlatfR}
+		  // $connection->{arr}{aPlatfS},
+		dep_loc  => $locs->[ $connection->{dep}{locX} ],
+		arr_loc  => $locs->[ $connection->{arr}{locX} ],
+		load     => $tco,
+		messages => \@messages,
+		sections => \@sections,
+	};
+
+	bless( $ref, $obj );
+
+	return $ref;
+}
+
+# }}}
+
+# {{{ Accessors
+
+sub messages {
+	my ($self) = @_;
+
+	if ( $self->{messages} ) {
+		return @{ $self->{messages} };
+	}
+	return;
+}
+
+sub sections {
+	my ($self) = @_;
+
+	if ( $self->{sections} ) {
+		return @{ $self->{sections} };
+	}
+	return;
+}
+
+# }}}
+
+1;
diff --git a/lib/Travel/Routing/DE/HAFAS/Connection/Section.pm b/lib/Travel/Routing/DE/HAFAS/Connection/Section.pm
new file mode 100644
index 0000000..6b85f1a
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Connection/Section.pm
@@ -0,0 +1,115 @@
+package Travel::Routing::DE::HAFAS::Connection::Section;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Class::Accessor';
+use DateTime::Duration;
+use Travel::Routing::DE::HAFAS::Utils;
+
+our $VERSION = '0.00';
+
+Travel::Routing::DE::HAFAS::Connection::Section->mk_ro_accessors(
+	qw(type schep_dep rt_dep sched_arr rt_arr dep_datetime arr_datetime arr_delay dep_delay journey distance duration dep_loc arr_loc
+	  operator id name category category_long class number line line_no load delay direction)
+);
+
+# {{{ Constructor
+
+sub new {
+	my ( $obj, %opt ) = @_;
+
+	my $hafas = $opt{hafas};
+	my $sec   = $opt{sec};
+	my $date  = $opt{date};
+	my $locs  = $opt{locL};
+	my @prodL = @{ $opt{common}{prodL} // [] };
+
+	my $strptime = DateTime::Format::Strptime->new(
+		pattern   => '%Y%m%dT%H%M%S',
+		time_zone => 'Europe/Berlin'
+	);
+
+	my $sched_dep = $sec->{dep}{dTimeS};
+	my $rt_dep    = $sec->{dep}{dTimeR};
+	my $sched_arr = $sec->{arr}{aTimeS};
+	my $rt_arr    = $sec->{arr}{aTimeR};
+
+	for my $ts ( $sched_dep, $rt_dep, $sched_arr, $rt_arr ) {
+		if ($ts) {
+			$ts = handle_day_change(
+				date     => $date,
+				time     => $ts,
+				strp_obj => $strptime,
+			);
+		}
+	}
+
+	my $ref = {
+		type         => $sec->{type},
+		sched_dep    => $sched_dep,
+		rt_dep       => $rt_dep,
+		sched_arr    => $sched_arr,
+		rt_arr       => $rt_arr,
+		dep_datetime => $rt_dep // $sched_dep,
+		arr_datetime => $rt_arr // $sched_arr,
+		dep_loc      => $locs->[ $sec->{dep}{locX} ],
+		arr_loc      => $locs->[ $sec->{arr}{locX} ],
+	};
+
+	if ( $sched_dep and $rt_dep ) {
+		$ref->{dep_delay} = ( $rt_dep->epoch - $sched_dep->epoch ) / 60;
+	}
+
+	if ( $sched_arr and $rt_arr ) {
+		$ref->{arr_delay} = ( $rt_arr->epoch - $sched_arr->epoch ) / 60;
+	}
+
+	if ( $sec->{type} eq 'JNY' ) {
+
+		#operator id name type type_long class number line line_no load delay direction)
+		my $journey = $sec->{jny};
+		my $product = $prodL[ $journey->{prodX} ];
+		$ref->{id}            = $journey->{jid};
+		$ref->{direction}     = $journey->{dirTxt};
+		$ref->{name}          = $product->{addName} // $product->{name};
+		$ref->{category}      = $product->{prodCtx}{catOut};
+		$ref->{category_long} = $product->{prodCtx}{catOutL};
+		$ref->{class}         = $product->{cls};
+		$ref->{number}        = $product->{prodCtx}{num};
+		$ref->{line}          = $ref->{name};
+		$ref->{line_no}       = $product->{prodCtx}{line};
+
+		if (    $ref->{name}
+			and $ref->{category}
+			and $ref->{name} eq $ref->{category}
+			and $product->{nameS} )
+		{
+			$ref->{name} .= ' ' . $product->{nameS};
+		}
+	}
+	elsif ( $sec->{type} eq 'WALK' ) {
+		$ref->{distance} = $sec->{gis}{dist};
+		my $duration = $sec->{gis}{durS};
+		$ref->{duration} = DateTime::Duration->new(
+			hours   => substr( $duration, 0, 2 ),
+			minutes => substr( $duration, 2, 2 ),
+			seconds => substr( $duration, 4, 2 ),
+		);
+	}
+
+	bless( $ref, $obj );
+
+	return $ref;
+}
+
+# }}}
+
+# {{{ Accessors
+
+# }}}
+
+1;
diff --git a/lib/Travel/Routing/DE/HAFAS/Location.pm b/lib/Travel/Routing/DE/HAFAS/Location.pm
new file mode 100644
index 0000000..170522c
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Location.pm
@@ -0,0 +1,33 @@
+package Travel::Routing::DE::HAFAS::Location;
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '0.00';
+
+Travel::Routing::DE::HAFAS::Location->mk_ro_accessors(
+	qw(lid type name eva state coordinate));
+
+sub new {
+	my ( $obj, %opt ) = @_;
+
+	my $loc = $opt{loc};
+
+	my $ref = {
+		lid        => $loc->{lid},
+		type       => $loc->{type},
+		name       => $loc->{name},
+		eva        => 0 + $loc->{extId},
+		state      => $loc->{state},
+		coordinate => $loc->{crd}
+	};
+
+	bless( $ref, $obj );
+
+	return $ref;
+}
+
+1;
diff --git a/lib/Travel/Routing/DE/HAFAS/Utils.pm b/lib/Travel/Routing/DE/HAFAS/Utils.pm
new file mode 100644
index 0000000..4b5bdb7
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Utils.pm
@@ -0,0 +1,32 @@
+package Travel::Routing::DE::HAFAS::Utils;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Exporter';
+our @EXPORT = qw(handle_day_change);
+
+sub handle_day_change {
+	my (%opt)       = @_;
+	my $datestr     = $opt{date};
+	my $timestr     = $opt{time};
+	my $offset_days = 0;
+
+	# timestr may include a day offset, resulting in DDHHMMSS
+	if ( length($timestr) == 8 ) {
+		$offset_days = substr( $timestr, 0, 2, q{} );
+	}
+
+	my $ts = $opt{strp_obj}->parse_datetime("${datestr}T${timestr}");
+
+	if ($offset_days) {
+		$ts->add( days => $offset_days );
+	}
+
+	return $ts;
+}
+
+1;