view release on metacpan or  search on metacpan

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

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;
        $path .= "/${value}";
    }

    # set the uri path including the path set in the base url
    $uri->path( $uri->path . $path );

    # add query parameters
    for my $param ( keys %{ $definition->{query_parameters} } ) {
        if ( my $value = $args{$param} ) {
            $uri->query_param( $param => $value );
        } 
        # check if param is required
        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'],
            query_parameters => { date => 1 },
        },
        departure_board => {
            method           => 'GET',
            path             => '/departureBoard',
            path_parameters  => ['id'],
            query_parameters => { date => 1 },
        },
        journey_details => {
            method          => 'GET',
            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 ),
            @args,
        },
    );
}

1;

=head1 LICENSE

Copyright (C) Edward Francis.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 AUTHOR

Edward Francis E<lt>edwardafrancis@gmail.comE<gt>

=cut