API-DeutscheBahn-Fahrplan

 view release on metacpan or  search on metacpan

cpanfile  view on Meta::CPAN

requires 'Carp', '1.50';
requires 'HTTP::Tiny', '0.076';
requires 'JSON::XS', '3.04';
requires 'Moose', '2.20';
requires 'URI', '1.74';
requires 'URI::Encode', '1.1.1';
requires 'URI::QueryParam', '1.74';
requires 'namespace::autoclean', '0';

on 'test' => sub {
    requires 'Test::Most', '0.35';
};

lib/API/DeutscheBahn/Fahrplan.pm  view on Meta::CPAN

=head1 METHODS

=head2 location

    $fahrplan->location( name => 'Berlin' );

Fetch information about locations matching the given name or name fragment.

=cut

sub location {
    return shift->_request( 'location', @_ );
}

=head2 arrival_board

    $fahrplan->arrival_board( id => 8503000, date => '2018-09-24T11:00:00' );

Fetch the arrival board at a given location at a given date and time. The date
parameter should be in the ISO-8601 format.

=cut

sub arrival_board {
    return shift->_request( 'arrival_board', @_ );
}

=head2 departure_board

    $fahrplan->departure_board( id => 8503000, date => '2018-09-24T11:00:00' );

Fetch the departure board at a given location at a given date and time. The date
parameter should be in the ISO-8601 format.

=cut

sub departure_board {
    return shift->_request( 'departure_board', @_ );
}

=head2 journey_details

    $fahrplan->journey_details( id => '87510%2F49419%2F965692%2F453678%2F80%3fstation_evaId%3D850300' );

Retrieve details of a journey for a given id.

=cut

sub journey_details {
    my ( $self, %args ) = @_;
    return $self->_request( 'journey_details',
        # id needs to be uri encoded
        id => uri_encode( $args{id} ) );
}


# PRIVATE METHODS


sub _request {
    my ( $self, $name, %args ) = @_;
    my ( $method, $uri ) = $self->_create_uri( $name, %args );
    my $response = $self->_client->$method($uri);
    return JSON::XS::decode_json $response->{content};
}


sub _create_uri {
    my ( $self, $name, %args ) = @_;

    my $uri        = $self->_base_uri;
    my $definition = $self->_api->{$name};
    my ( $method, $path ) = @{$definition}{qw(method path)};

    # add path parameters
    for ( @{ $definition->{path_parameters} } ) {
        my $value = $args{$_};
        croak sprintf 'Missing path parameter: %s', $_ unless $value;

lib/API/DeutscheBahn/Fahrplan.pm  view on Meta::CPAN

        elsif ( $definition->{query_parameters}->{$param} ) {
            croak sprintf 'Missing query parameter: %s', $param;
        }
    }

    return ( lc $method, $uri );

}


sub _base_uri {
    return URI->new(
          $_[0]->access_token
        ? $_[0]->fahrplan_plus_url
        : $_[0]->fahrplan_free_url
    );
}


sub _api {
    return {
        location => {
            method          => 'GET',
            path            => '/location',
            path_parameters => ['name'],
        },
        arrival_board => {
            method           => 'GET',
            path             => '/arrivalBoard',
            path_parameters  => ['id'],

lib/API/DeutscheBahn/Fahrplan.pm  view on Meta::CPAN

            path            => '/journeyDetails',
            path_parameters => ['id'],
        },
    };
}


# BUILDERS


sub _build_client {
    my $self = $_[0];
    my @args;

    push @args, 'Authorization' => sprintf( 'Bearer %s', $self->access_token )
        if $self->access_token;

    return HTTP::Tiny->new(
        default_headers => {
            'Accept'     => 'application/json',
            'User-Agent' => sprintf( 'Perl-%s::%s', __PACKAGE__, $VERSION ),