From ab87fea76dc850dddd8d01aa6737d93260c7f7d9 Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Thu, 12 Nov 2015 08:56:50 +0100 Subject: Result: Do not try parsing undef timestamps, re-use existing strptime object * fixes undef warnings in recent DateTime::Format::Strptime versions * Improves parser performance quite a bit --- lib/Travel/Status/DE/IRIS/Result.pm | 73 ++++++++++++++----------------------- 1 file changed, 27 insertions(+), 46 deletions(-) (limited to 'lib/Travel/Status/DE') diff --git a/lib/Travel/Status/DE/IRIS/Result.pm b/lib/Travel/Status/DE/IRIS/Result.pm index 23765ec..211f442 100644 --- a/lib/Travel/Status/DE/IRIS/Result.pm +++ b/lib/Travel/Status/DE/IRIS/Result.pm @@ -111,18 +111,20 @@ sub new { my $ref = \%opt; - my $strp = DateTime::Format::Strptime->new( + my ( $train_id, $start_ts, $stop_no ) = split( /.\K-/, $opt{raw_id} ); + + bless( $ref, $obj ); + + $ref->{strptime_obj} = DateTime::Format::Strptime->new( pattern => '%y%m%d%H%M', time_zone => 'Europe/Berlin', ); - my ( $train_id, $start_ts, $stop_no ) = split( /.\K-/, $opt{raw_id} ); - $ref->{wing_id} = "${train_id}-${start_ts}"; $ref->{is_wing} = 0; $train_id =~ s{^-}{}; - $ref->{start} = $strp->parse_datetime($start_ts); + $ref->{start} = $ref->parse_ts($start_ts); $ref->{train_id} = $train_id; $ref->{stop_no} = $stop_no; @@ -134,9 +136,9 @@ sub new { } my $ar = $ref->{arrival} = $ref->{sched_arrival} - = $strp->parse_datetime( $opt{arrival_ts} ); + = $ref->parse_ts( $opt{arrival_ts} ); my $dp = $ref->{departure} = $ref->{sched_departure} - = $strp->parse_datetime( $opt{departure_ts} ); + = $ref->parse_ts( $opt{departure_ts} ); if ( not( $ar or $dp ) ) { cluck( @@ -178,23 +180,27 @@ sub new { return bless( $ref, $obj ); } +sub parse_ts { + my ( $self, $string ) = @_; + + if ( defined $string ) { + return $self->{strptime_obj}->parse_datetime($string); + } + return; +} + sub set_ar { my ( $self, %attrib ) = @_; - my $strp = DateTime::Format::Strptime->new( - pattern => '%y%m%d%H%M', - time_zone => 'Europe/Berlin', - ); - # unscheduled arrivals may not appear in the plan, but we do need to # know their planned arrival time if ( $attrib{plan_arrival_ts} ) { $self->{sched_arrival} - = $strp->parse_datetime( $attrib{plan_arrival_ts} ); + = $self->parse_ts( $attrib{plan_arrival_ts} ); } if ( $attrib{arrival_ts} ) { - $self->{arrival} = $strp->parse_datetime( $attrib{arrival_ts} ); + $self->{arrival} = $self->parse_ts( $attrib{arrival_ts} ); $self->{delay} = $self->arrival->subtract_datetime( $self->sched_arrival ) ->in_units('minutes'); @@ -240,20 +246,15 @@ sub set_ar { sub set_dp { my ( $self, %attrib ) = @_; - my $strp = DateTime::Format::Strptime->new( - pattern => '%y%m%d%H%M', - time_zone => 'Europe/Berlin', - ); - # unscheduled arrivals may not appear in the plan, but we do need to # know their planned arrival time if ( $attrib{plan_departure_ts} ) { $self->{sched_departure} - = $strp->parse_datetime( $attrib{plan_departure_ts} ); + = $self->parse_ts( $attrib{plan_departure_ts} ); } if ( $attrib{departure_ts} ) { - $self->{departure} = $strp->parse_datetime( $attrib{departure_ts} ); + $self->{departure} = $self->parse_ts( $attrib{departure_ts} ); $self->{delay} = $self->departure->subtract_datetime( $self->sched_departure ) ->in_units('minutes'); @@ -454,11 +455,6 @@ sub destination { sub delay_messages { my ($self) = @_; - my $strp = DateTime::Format::Strptime->new( - pattern => '%y%m%d%H%M', - time_zone => 'Europe/Berlin', - ); - my @keys = reverse sort keys %{ $self->{messages} }; my @msgs = grep { $_->[1] eq 'd' } map { $self->{messages}{$_} } @keys; my @msgids = uniq( map { $_->[2] } @msgs ); @@ -467,7 +463,7 @@ sub delay_messages { for my $id (@msgids) { my $msg = firstval { $_->[2] == $id } @msgs; push( @ret, - [ $strp->parse_datetime( $msg->[0] ), $self->translate_msg($id) ] ); + [ $self->parse_ts( $msg->[0] ), $self->translate_msg($id) ] ); } return @ret; @@ -518,11 +514,6 @@ sub dump_message_codes { sub qos_messages { my ($self) = @_; - my $strp = DateTime::Format::Strptime->new( - pattern => '%y%m%d%H%M', - time_zone => 'Europe/Berlin', - ); - my @keys = sort keys %{ $self->{messages} }; my @msgs = grep { $_->[1] ~~ [qw[f q]] } map { $self->{messages}{$_} } @keys; @@ -541,9 +532,9 @@ sub qos_messages { } } - @ret = map { - [ $strp->parse_datetime( $_->[0] ), $self->translate_msg( $_->[2] ) ] - } reverse @ret; + @ret + = map { [ $self->parse_ts( $_->[0] ), $self->translate_msg( $_->[2] ) ] } + reverse @ret; return @ret; } @@ -551,15 +542,10 @@ sub qos_messages { sub raw_messages { my ($self) = @_; - my $strp = DateTime::Format::Strptime->new( - pattern => '%y%m%d%H%M', - time_zone => 'Europe/Berlin', - ); - my @messages = reverse sort keys %{ $self->{messages} }; my @ret = map { [ - $strp->parse_datetime( $self->{messages}->{$_}->[0] ), + $self->parse_ts( $self->{messages}->{$_}->[0] ), $self->{messages}->{$_}->[2] ] } @messages; @@ -570,15 +556,10 @@ sub raw_messages { sub messages { my ($self) = @_; - my $strp = DateTime::Format::Strptime->new( - pattern => '%y%m%d%H%M', - time_zone => 'Europe/Berlin', - ); - my @messages = reverse sort keys %{ $self->{messages} }; my @ret = map { [ - $strp->parse_datetime( $self->{messages}->{$_}->[0] ), + $self->parse_ts( $self->{messages}->{$_}->[0] ), $self->translate_msg( $self->{messages}->{$_}->[2] ) ] } @messages; -- cgit v1.2.3