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

Initial commit

parents

bin/dbris-m

0 → 100755
+155 −0
Original line number Diff line number Diff line 
#!perl

use strict;

use warnings;

use 5.020;



our $VERSION = '0.01';



use utf8;

use DateTime;

use Encode qw(decode);

use JSON;

use Getopt::Long qw(:config no_ignore_case);

use Travel::Status::DE::DBRIS;



my $developer_mode;

my $use_cache = 1;

my $cache;

my ( $json_output, $raw_json_output );



my @output;



binmode( STDOUT, ':encoding(utf-8)' );

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{};



GetOptions(

	'h|help'    => sub { show_help(0) },

	'V|version' => \&show_version,

	'cache!'    => \$use_cache,

	'devmode'   => \$developer_mode,

	'json'      => \$json_output,

	'raw-json'  => \$raw_json_output,



) or show_help(1);



if ($use_cache) {

	my $cache_path = ( $ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache" )

	  . '/Travel-Status-DE-HAFAS';

	eval {

		require Cache::File;

		$cache = Cache::File->new(

			cache_root      => $cache_path,

			default_expires => '90 seconds',

			lock_level      => Cache::File::LOCK_LOCAL(),

		);

	};

	if ($@) {

		$cache = undef;

	}

}



my %opt = (

	cache          => $cache,

	station        => shift || show_help(1),

	developer_mode => $developer_mode,

);



if ( $opt{station} =~ m{ ^ (?<lat> [0-9.]+ ) : (?<lon> [0-9].+ ) $ }x ) {

	$opt{geoSearch} = {

		latitude  => $+{lat},

		longitude => $+{lon},

	};

	delete $opt{station};

}

elsif ( $opt{station} =~ m{ ^ [?] (?<query> .*) $ }x ) {

	$opt{locationSearch} = $+{query};

	delete $opt{station};

}

elsif ( $opt{station} =~ m{[|]} ) {

	$opt{journey} = { id => $opt{station} };

	delete $opt{station};

}



my $status = Travel::Status::DE::DBRIS->new(%opt);



sub show_help {

	my ($code) = @_;



	print "Usage: db-ris-m <station|lat:lon>\n" . "See also: man dbris-m\n";



	exit $code;

}



sub show_version {

	say "dbris-m version ${VERSION}";



	exit 0;

}



sub spacer {

	my ($len) = @_;

	return ( $len % 2 ? q { } : q{} ) . ( q{ ·} x ( $len / 2 ) );

}



sub display_occupancy {

	my ($occupancy) = @_;



	if ( not $occupancy ) {

		return q{ };

	}

	if ( $occupancy == 1 ) {

		return q{.};

	}

	if ( $occupancy == 2 ) {

		return q{o};

	}

	if ( $occupancy == 3 ) {

		return q{*};

	}

	if ( $occupancy == 4 ) {

		return q{!};

	}

	return q{?};

}



sub format_delay {

	my ( $delay, $len ) = @_;

	if ( $delay and $len ) {

		return sprintf( "(%+${len}d)", $delay );

	}

	return q{};

}



if ( my $err = $status->errstr ) {

	say STDERR "Request error: ${err}";

	exit 2;

}



if ($raw_json_output) {

	say JSON->new->convert_blessed->encode( $status->{raw_json} );

	exit 0;

}



if ($json_output) {

	if ( $opt{journey} ) {

		say JSON->new->convert_blessed->encode( $status->result );

	}

	else {

		say JSON->new->convert_blessed->encode( [ $status->results ] );

	}

	exit 0;

}



if ( $opt{station} ) {

	die("Unimplemented");

}

elsif ( $opt{geoSearch} ) {

	for my $result ( $status->results ) {

		printf( "%8d  %s\n", $result->eva, $result->name );

	}

}

lib/Travel/Status/DE/DBRIS.pm

0 → 100644
+277 −0
Original line number Diff line number Diff line 
package Travel::Status::DE::DBRIS;



# vim:foldmethod=marker



use strict;

use warnings;

use 5.020;

use utf8;



use Carp qw(confess);

use DateTime;

use DateTime::Format::Strptime;

use Encode qw(decode encode);

use JSON;

use LWP::UserAgent;

use Travel::Status::DE::DBRIS::Location;



our $VERSION = '0.01';



# {{{ Constructors



sub new {

	my ( $obj, %conf ) = @_;

	my $service = $conf{service};



	my $ua = $conf{user_agent};



	if ( not $ua ) {

		my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };

		$ua = LWP::UserAgent->new(%lwp_options);

		$ua->env_proxy;

	}



	my $now  = DateTime->now( time_zone => 'Europe/Berlin' );

	my $self = {

		cache          => $conf{cache},

		developer_mode => $conf{developer_mode},

		messages       => [],

		results        => [],

		station        => $conf{station},

		ua             => $ua,

		now            => $now,

		tz_offset      => $now->offset / 60,

	};



	bless( $self, $obj );



	my $req;



	if ( my $eva = $conf{station} ) {

		$req

		  = "https://www.bahnhof.de/api/boards/departures?evaNumbers=${eva}&duration=60&stationCategory=1&locale=de&sortBy=TIME_SCHEDULE";

	}

	elsif ( my $gs = $conf{geoSearch} ) {

		my $lat = $gs->{latitude};

		my $lon = $gs->{longitude};

		$req

		  = "https://www.bahn.de/web/api/reiseloesung/orte/nearby?lat=${lat}&long=${lon}&radius=9999&maxNo=100";

	}



	# journey : https://www.bahn.de/web/api/reiseloesung/fahrt?journeyId=2%7C%23VN%231%23ST%231733779122%23PI%230%23ZI%23324190%23TA%230%23DA%23141224%231S%238000001%231T%231822%23LS%238000080%23LT%232050%23PU%2380%23RT%231%23CA%23DPN%23ZE%2326431%23ZB%23RE+26431%23PC%233%23FR%238000001%23FT%231822%23TO%238000080%23TT%232050%23&poly=true

	else {

		confess('station or geoSearch must be specified');

	}



	#$self->{strptime_obj} //= DateTime::Format::Strptime->new(

	#	pattern   => '%Y%m%dT%H%M%S',

	#	time_zone => $hafas_instance->{$service}{time_zone} // 'Europe/Berlin',

	#);



	my $json = $self->{json} = JSON->new->utf8;



	if ( $conf{async} ) {

		$self->{req} = $req;

		return $self;

	}



	if ( $conf{json} ) {

		$self->{raw_json} = $conf{json};

	}

	else {

		if ( $self->{developer_mode} ) {

			say "requesting $req";

		}



		my ( $content, $error ) = $self->get_with_cache($req);



		if ($error) {

			$self->{errstr} = $error;

			return $self;

		}



		if ( $self->{developer_mode} ) {

			say decode( 'utf-8', $content );

		}



		$self->{raw_json} = $json->decode($content);

	}



	if ( $conf{station} ) {

		$self->parse_stationboard;

	}

	elsif ( $conf{geoSearch} ) {

		$self->parse_geosearch;

	}



	return $self;

}



sub new_p {

	my ( $obj, %conf ) = @_;

	my $promise = $conf{promise}->new;



	if (

		not(   $conf{station}

			or $conf{geoSearch} )

	  )

	{

		return $promise->reject('station / geoSearch flag must be passed');

	}



	my $self = $obj->new( %conf, async => 1 );

	$self->{promise} = $conf{promise};



	$self->get_with_cache_p( $self->{url} )->then(

		sub {

			my ($content) = @_;

			$self->{raw_json} = $self->{json}->decode($content);

			if ( $conf{station} ) {

				$self->parse_stationboard;

			}

			elsif ( $conf{geoSearch} ) {

				$self->parse_search;

			}

			else {

				$promise->resolve($self);

			}

			return;

		}

	)->catch(

		sub {

			my ($err) = @_;

			$promise->reject($err);

			return;

		}

	)->wait;



	return $promise;

}



# }}}

# {{{ Internal Helpers



sub get_with_cache {

	my ( $self, $url ) = @_;

	my $cache = $self->{cache};



	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 $reply = $self->{ua}->get($url);



	if ( $reply->is_error ) {

		return ( undef, $reply->status_line );

	}

	my $content = $reply->content;



	if ($cache) {

		$cache->freeze( $url, \$content );

	}



	return ( $content, undef );

}



sub get_with_cache_p {

	my ( $self, $url ) = @_;

	my $cache = $self->{cache};



	if ( $self->{developer_mode} ) {

		say "GET $url";

	}



	my $promise = $self->{promise}->new;



	if ($cache) {

		my $content = $cache->thaw($url);

		if ($content) {

			if ( $self->{developer_mode} ) {

				say '  cache hit';

			}

			return $promise->resolve( ${$content} );

		}

	}



	if ( $self->{developer_mode} ) {

		say '  cache miss';

	}



	$self->{ua}->get_p($url)->then(

		sub {

			my ($tx) = @_;

			if ( my $err = $tx->error ) {

				$promise->reject(

					"GET $url returned HTTP $err->{code} $err->{message}");

				return;

			}

			my $content = $tx->res->body;

			if ($cache) {

				$cache->freeze( $url, \$content );

			}

			$promise->resolve($content);

			return;

		}

	)->catch(

		sub {

			my ($err) = @_;

			$promise->reject($err);

			return;

		}

	)->wait;



	return $promise;

}



sub parse_geosearch {

	my ($self) = @_;



	$self->{results} = [];



	if ( $self->{errstr} ) {

		return $self;

	}



	@{ $self->{results} }

	  = map { Travel::Status::DE::DBRIS::Location->new( json => $_ ) }

	  @{ $self->{raw_json} // [] };



	return $self;

}



# }}}

# {{{ Public Functions



sub errstr {

	my ($self) = @_;



	return $self->{errstr};

}



sub results {

	my ($self) = @_;

	return @{ $self->{results} };

}



sub result {

	my ($self) = @_;

	return $self->{result};

}



# }}}



1;

lib/Travel/Status/DE/DBRIS/Location.pm

0 → 100644
+42 −0
Original line number Diff line number Diff line 
package Travel::Status::DE::DBRIS::Location;



use strict;

use warnings;

use 5.020;



use parent 'Class::Accessor';



our $VERSION = '0.01';



Travel::Status::DE::DBRIS::Location->mk_ro_accessors(

	qw(eva id lat lon name products type));



sub new {

	my ( $obj, %opt ) = @_;



	my $json = $opt{json};



	my $ref = {

		eva      => $json->{extId},

		id       => $json->{id},

		lat      => $json->{lat},

		lon      => $json->{lon},

		name     => $json->{name},

		products => $json->{products},

		type     => $json->{type},

	};



	bless( $ref, $obj );



	return $ref;

}



sub TO_JSON {

	my ($self) = @_;



	my $ret = { %{$self} };



	return $ret;

}



1;