diff options
| -rw-r--r-- | Build.PL | 5 | ||||
| -rw-r--r-- | Changelog | 9 | ||||
| -rw-r--r-- | README.md | 9 | ||||
| -rwxr-xr-x | bin/dbris | 62 | ||||
| -rw-r--r-- | lib/Travel/Routing/DE/DBRIS.pm | 55 | ||||
| -rw-r--r-- | lib/Travel/Routing/DE/DBRIS/Connection.pm | 2 | ||||
| -rw-r--r-- | lib/Travel/Routing/DE/DBRIS/Connection/Segment.pm | 2 | ||||
| -rw-r--r-- | lib/Travel/Routing/DE/DBRIS/Offer.pm | 2 | ||||
| -rwxr-xr-x | scripts/makedeb-docker | 2 | ||||
| -rwxr-xr-x | scripts/makedeb-docker-helper | 4 |
10 files changed, 100 insertions, 52 deletions
@@ -26,12 +26,13 @@ Module::Build->new( 'DateTime::Duration' => 0, 'DateTime::Format::Strptime' => 0, 'Getopt::Long' => 0, + 'IO::Uncompress::Gunzip' => 0, 'JSON' => 0, 'List::Util' => 0, 'LWP::UserAgent' => 0, 'LWP::Protocol::https' => 0, - 'Travel::Status::DE::DBRIS' => '0.05', - 'Travel::Status::DE::DBRIS::Location' => '0.05', + 'Travel::Status::DE::DBRIS' => '0.08', + 'Travel::Status::DE::DBRIS::Location' => '0.08', }, script_files => 'bin/', sign => 1, @@ -1,3 +1,12 @@ +Travel::Routing::DE::DBRIS 0.07 - Sat Jun 21 2025 + + * dbris: Add--colour={auto,always,never} + +Travel::Routing::DE::DBRIS 0.06 - Thu Feb 20 2025 + + * Handle gzip-compressed bahn.de responses -- older versions of this + module no longer work + Travel::Routing::DE::DBRIS 0.05 - Sat Feb 08 2025 * dbris: Bump dependency version to really fix --json @@ -37,9 +37,12 @@ Debian repository and are not covered by its quality assurance process. To install the latest release, run: ``` -wget https://lib.finalrewind.org/deb/libtravel-routing-de-dbris-perl_latest_all.deb -sudo apt install ./libtravel-routing-de-dbris-perl_latest_all.deb -rm libtravel-routing-de-dbris-perl_latest_all.deb +wget https://lib.finalrewind.org/deb/libtravel-status-de-dbris-perl_latest_all.deb \ + https://lib.finalrewind.org/deb/libtravel-routing-de-dbris-perl_latest_all.deb +sudo apt install ./libtravel-status-de-dbris-perl_latest_all.deb \ + ./libtravel-routing-de-dbris-perl_latest_all.deb +rm libtravel-status-de-dbris-perl_latest_all.deb \ + libtravel-routing-de-dbris-perl_latest_all.deb ``` Uninstallation works as usual: @@ -3,7 +3,7 @@ use strict; use warnings; use 5.020; -our $VERSION = '0.05'; +our $VERSION = '0.07'; use utf8; use DateTime; @@ -21,7 +21,8 @@ my ( $show_offers, $show_upsell_offers, $show_cross_offers ); my ( $first_class, $passengers ); my ( $developer_mode, $verbose ); my ( $json_output, $raw_json_output ); -my $use_cache = 1; +my $use_cache = 1; +my $use_colour = 'auto'; my $cache; my %known_mot = map { $_ => 1 } @@ -32,20 +33,20 @@ for my $arg (@ARGV) { $arg = decode( 'UTF-8', $arg ); } -my $output_bold = -t STDOUT ? "\033[1m" : q{}; -my $output_reset = -t STDOUT ? "\033[0m" : q{}; +my $output_bold = "\033[1m"; +my $output_reset = "\033[0m"; -my $output_fyi = -t STDOUT ? "\033[40;36m" : q{}; -my $output_unknown = -t STDOUT ? "\033[40;35m" : q{}; -my $output_good = -t STDOUT ? "\033[40;32m" : q{}; -my $output_warning = -t STDOUT ? "\033[40;33m" : q{}; -my $output_critical = -t STDOUT ? "\033[40;31m" : q{}; +my $output_fyi = "\033[40;36m"; +my $output_unknown = "\033[40;35m"; +my $output_good = "\033[40;32m"; +my $output_warning = "\033[40;33m"; +my $output_critical = "\033[40;31m"; -my $output_bold_fyi = -t STDOUT ? "\033[1;40;36m" : q{}; -my $output_bold_unknown = -t STDOUT ? "\033[1;40;35m" : q{}; -my $output_bold_good = -t STDOUT ? "\033[1;40;32m" : q{}; -my $output_bold_warning = -t STDOUT ? "\033[1;40;33m" : q{}; -my $output_bold_critical = -t STDOUT ? "\033[1;40;31m" : q{}; +my $output_bold_fyi = "\033[1;40;36m"; +my $output_bold_unknown = "\033[1;40;35m"; +my $output_bold_good = "\033[1;40;32m"; +my $output_bold_warning = "\033[1;40;33m"; +my $output_bold_critical = "\033[1;40;31m"; GetOptions( 'a|arrive=s' => sub { $arrival = 1; $time = $_[1] }, @@ -64,12 +65,25 @@ GetOptions( 'v|verbose' => \$verbose, 'V|version' => \&show_version, 'cache!' => \$use_cache, + 'color=s' => \$use_colour, + 'colour=s' => \$use_colour, 'devmode' => \$developer_mode, 'json' => \$json_output, 'raw-json' => \$raw_json_output, ) or show_help(1); +if ( $use_colour eq 'auto' + and ( not -t STDOUT or ( defined $ENV{TERM} and $ENV{TERM} eq 'dumb' ) ) + or $use_colour eq 'never' ) +{ + $output_bold = $output_reset = q{}; + $output_fyi = $output_unknown = $output_good = $output_warning + = $output_critical = q{}; + $output_bold_fyi = $output_bold_unknown = $output_bold_good + = $output_bold_warning = $output_bold_critical = q{}; +} + if ($use_cache) { my $cache_path = ( $ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache" ) . '/Travel-Routing-DE-DBRIS'; @@ -346,10 +360,12 @@ for my $connection ( $ris->connections ) { map { length( $_->dep_delay || q{} ), length( $_->arr_delay || q{} ) } $connection->segments; if ($show_full_route) { - my $max_route_delay_digits = max map { - map { length( $_->arr_delay || q{} ) } - $_->route - } $connection->segments; + my $max_route_delay_digits = ( + max map { + map { length( $_->arr_delay || q{} ) } + $_->route + } $connection->segments + ) // 0; if ( $max_route_delay_digits > $max_delay_digits ) { $max_delay_digits = $max_route_delay_digits; } @@ -533,7 +549,7 @@ B<dbris> [B<-d> I<DD.MM.YYYY>] [B<-a>|B<-t> I<HH:MM>] [...] I<from-stop> =head1 VERSION -version 0.05 +version 0.07 =head1 DESCRIPTION @@ -551,6 +567,14 @@ connections, with an optional minimum stopover I<duration> given in minutes. Request connections that arrive on or after I<HH:MM>. Overrides B<--time>. +=item B<--colour>, B<--color> B<always>|B<auto>|B<never> + +By default, B<dbris-m> uses ANSI escape codes for output formatting whenever +the output is connected to a terminal and the TERM environment variable is not +set to C<< dumb >>. B<--colour=always> causes it to always use output +formatting regardless of terminal setup, and B<--colour=never> disables any +formatting. B<--colour=auto> restores the default behaviour. + =item B<-d>, B<--date> I<dd.mm.>[I<yyyy>] Request connections for a specific day. diff --git a/lib/Travel/Routing/DE/DBRIS.pm b/lib/Travel/Routing/DE/DBRIS.pm index f0892c6..4d93cf9 100644 --- a/lib/Travel/Routing/DE/DBRIS.pm +++ b/lib/Travel/Routing/DE/DBRIS.pm @@ -14,11 +14,12 @@ use DateTime::Format::Strptime; use Encode qw(decode encode); use JSON; use LWP::UserAgent; +use IO::Uncompress::Gunzip; use Travel::Status::DE::DBRIS; use Travel::Routing::DE::DBRIS::Connection; use Travel::Routing::DE::DBRIS::Offer; -our $VERSION = '0.05'; +our $VERSION = '0.07'; Travel::Routing::DE::DBRIS->mk_ro_accessors(qw(earlier later)); @@ -61,13 +62,13 @@ sub new { @mots = @{ $conf{modes_of_transit} // [] }; } - my ($req_url, $req); + my ( $req_url, $req ); - if ($conf{from} and $conf{to}) { + if ( $conf{from} and $conf{to} ) { $req_url - = $self->{language} eq 'de' - ? 'https://www.bahn.de/web/api/angebote/fahrplan' - : 'https://int.bahn.de/web/api/angebote/fahrplan'; + = $self->{language} eq 'de' + ? 'https://www.bahn.de/web/api/angebote/fahrplan' + : 'https://int.bahn.de/web/api/angebote/fahrplan'; $req = { abfahrtsHalt => $conf{from}->id, ankunftsHalt => $conf{to}->id, @@ -96,15 +97,15 @@ sub new { deutschlandTicketVorhanden => \0 }; } - elsif ($conf{offers}) { + elsif ( $conf{offers} ) { $req_url - = $self->{language} eq 'de' - ? 'https://www.bahn.de/web/api/angebote/recon' - : 'https://int.bahn.de/web/api/angebote/recon'; + = $self->{language} eq 'de' + ? 'https://www.bahn.de/web/api/angebote/recon' + : 'https://int.bahn.de/web/api/angebote/recon'; $req = { - klasse => $conf{first_class} ? 'KLASSE_1' : 'KLASSE_2', + klasse => $conf{first_class} ? 'KLASSE_1' : 'KLASSE_2', ctxRecon => $conf{offers}{recon}, - reisende => [ + reisende => [ { typ => 'ERWACHSENER', ermaessigungen => [ @@ -203,22 +204,28 @@ sub new { say "requesting $req_str"; } - my ( $content, $error ) = $self->post_with_cache( $req_url, $req_str ); + my ( $raw_content, $error ) + = $self->post_with_cache( $req_url, $req_str ); if ($error) { $self->{errstr} = $error; return $self; } + my $gunzip = IO::Uncompress::Gunzip->new( \$raw_content, Append => 1 ); + my $content = q{}; + + while ( $gunzip->read($content) ) { } + if ( $self->{developer_mode} ) { say decode( 'utf-8', $content ); } $self->{raw_json} = $json->decode($content); - if ($conf{from} and $conf{to}) { + if ( $conf{from} and $conf{to} ) { $self->parse_connections; } - elsif ($conf{offers}) { + elsif ( $conf{offers} ) { $self->parse_offers; } } @@ -288,6 +295,7 @@ sub post_with_cache { my $reply = $self->{ua}->post( $url, Accept => 'application/json', + 'Accept-Encoding' => 'gzip', 'Accept-Language' => $self->{language}, 'Content-Type' => 'application/json; charset=utf-8', Content => $req, @@ -332,10 +340,13 @@ sub parse_connections { sub parse_offers { my ($self) = @_; - for my $offer (@{$self->{raw_json}{verbindungen}[0]{reiseAngebote} // []}) { - push(@{$self->{offers}}, Travel::Routing::DE::DBRIS::Offer->new( - json => $offer - )); + for + my $offer ( @{ $self->{raw_json}{verbindungen}[0]{reiseAngebote} // [] } ) + { + push( + @{ $self->{offers} }, + Travel::Routing::DE::DBRIS::Offer->new( json => $offer ) + ); } } @@ -350,12 +361,12 @@ sub errstr { sub connections { my ($self) = @_; - return @{ $self->{connections} // []}; + return @{ $self->{connections} // [] }; } sub offers { my ($self) = @_; - return @{$self->{offers} // [] }; + return @{ $self->{offers} // [] }; } # }}} @@ -402,7 +413,7 @@ Travel::Routing::DE::DBRIS - Interface to the bahn.de itinerary service =head1 VERSION -version 0.05 +version 0.07 =head1 DESCRIPTION diff --git a/lib/Travel/Routing/DE/DBRIS/Connection.pm b/lib/Travel/Routing/DE/DBRIS/Connection.pm index b03a2cb..6ba0494 100644 --- a/lib/Travel/Routing/DE/DBRIS/Connection.pm +++ b/lib/Travel/Routing/DE/DBRIS/Connection.pm @@ -10,7 +10,7 @@ use parent 'Class::Accessor'; use DateTime::Duration; use Travel::Routing::DE::DBRIS::Connection::Segment; -our $VERSION = '0.05'; +our $VERSION = '0.07'; Travel::Routing::DE::DBRIS::Connection->mk_ro_accessors( qw(changes feasibility is_cancelled is_unscheduled is_unlikely diff --git a/lib/Travel/Routing/DE/DBRIS/Connection/Segment.pm b/lib/Travel/Routing/DE/DBRIS/Connection/Segment.pm index e327125..c9c4291 100644 --- a/lib/Travel/Routing/DE/DBRIS/Connection/Segment.pm +++ b/lib/Travel/Routing/DE/DBRIS/Connection/Segment.pm @@ -9,7 +9,7 @@ use parent 'Class::Accessor'; use DateTime::Duration; use Travel::Status::DE::DBRIS::Location; -our $VERSION = '0.05'; +our $VERSION = '0.07'; Travel::Routing::DE::DBRIS::Connection::Segment->mk_ro_accessors( qw( diff --git a/lib/Travel/Routing/DE/DBRIS/Offer.pm b/lib/Travel/Routing/DE/DBRIS/Offer.pm index 8a29c9c..9a813fc 100644 --- a/lib/Travel/Routing/DE/DBRIS/Offer.pm +++ b/lib/Travel/Routing/DE/DBRIS/Offer.pm @@ -7,7 +7,7 @@ use utf8; use parent 'Class::Accessor'; -our $VERSION = '0.05'; +our $VERSION = '0.07'; Travel::Routing::DE::DBRIS::Offer->mk_ro_accessors( qw(class name price price_unit is_upsell is_cross_sell needs_context)); diff --git a/scripts/makedeb-docker b/scripts/makedeb-docker index 6c06971..ceba8f8 100755 --- a/scripts/makedeb-docker +++ b/scripts/makedeb-docker @@ -6,6 +6,6 @@ docker run --rm -v "${PWD}:/orig:ro" -v "${PWD}/scripts:/scripts:ro" \ -v "${PWD}/out:/out" -e USER=$(id -u) -e GROUP=$(id -g) \ -e "DEBEMAIL=${DEBEMAIL}" -e "DEBFULLNAME=${DEBFULLNAME}" \ -e "LOGNAME=${LOGNAME}" -e "VERSION=$(git describe --dirty)-1" \ - debian:buster /scripts/makedeb-docker-helper + debian:bookworm /scripts/makedeb-docker-helper echo "Debian package has been written to $(pwd)/out" diff --git a/scripts/makedeb-docker-helper b/scripts/makedeb-docker-helper index 71338e7..a622da0 100755 --- a/scripts/makedeb-docker-helper +++ b/scripts/makedeb-docker-helper @@ -15,8 +15,8 @@ apt-get -y install \ libtest-compile-perl libtest-pod-perl \ libtest-simple-perl wget -wget https://lib.finalrewind.org/deb/libtravel-status-de-dbris-perl_0.05-1_all.deb -dpkg -i libtravel-status-de-dbris-perl_0.05-1_all.deb +wget https://lib.finalrewind.org/deb/libtravel-status-de-dbris-perl_0.11-1_all.deb +dpkg -i libtravel-status-de-dbris-perl_0.11-1_all.deb apt-file update apt-cache dumpavail | dpkg --merge-avail |