API-Handle
view release on metacpan or search on metacpan
NAME
API::Handle
VERSION
version 0.02
_tied
Recursively tie \[ key => $val, key => $val, ... ] data to create
preserved-order hashes ( needed for SOAP ).
AUTHOR
Nour Sharabash <amirite@cpan.org>
COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Nour Sharabash.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
lib/API/Handle.pm view on Meta::CPAN
, verbose => 1
, dumper => 1
, debug => 1
, pid => 1
);
require Nour::Printer;
return new Nour::Printer ( %conf );
}
);
has _database => (
is => 'rw'
, isa => 'Nour::Database'
, required => 1
, lazy => 1
, default => sub {
my $self = shift;
my %conf = $self->config->{database} ? %{ $self->config->{database} } : (
# default options here
);
%conf = ();
require Nour::Database;
return new Nour::Database ( %conf );
}
);
#has _util # TODO factor all the _methods to $self->util->methods... or not
lib/API/Handle.pm view on Meta::CPAN
$self->$attr( $self->config->{ $attr } )
if $self->can( $attr );
}
# Add request wrapper.
$self->ua->add_handler(
request_prepare => sub {
my ( $req, $ua, $h ) = @_;
# Set Content-Length header.
if ( my $data = $req->content ) {
$req->headers->header( 'Content-Length' => $self->_bytes( $data ) );
}
}
);
}
sub req {
my ( $self, %args ) = @_;
my $req = new HTTP::Request;
$args{content} ||= $args{data} ||= $args{body};
$args{method} ||= $args{type};
$args{uri} ||= $self->_join_uri( $args{path} );
# Preserve hash order. Maybe needed for SOAP.
if ( defined $args{content} and (
( ref $args{content} eq 'ARRAY' ) or # Deprecated - backwards compatibility
( ref $args{content} eq 'REF' and ref ${ $args{content} } eq 'ARRAY' ) # New style ? => \[]
)
) {
$self->_tied( ref => \%args, key => 'content', tied => 1 );
}
# Leave it up to the API implementation to encode the hash/array ref into JSON / Form data / XML / etc.
$req->content( $args{content} ) if defined $args{content};
$req->method( $args{method} ) if defined $args{method};
$req->uri( $args{uri} );
my $res = $self->ua->request( $req );
return wantarray ? ( $res, $req ) : $res;
}
sub db {
my ( $self, @args ) = @_;
$self->_database->switch_to( @args ) if @args;
return $self->_database;
}
# TODO: change all references to ->_encode to use ->encode and rename sub-routines
# TODO: same for _decode
sub _encode {
my ( $self, %args ) = @_;
my ( $data );
for ( $args{type} ) {
when ( 'json' ) {
$data = $self->_json->encode( $args{data} );
}
when ( 'xml' ) {
$data = $self->_xml->write( $args{data} );
}
when ( 'form' ) {
require URI;
my $uri = URI->new('http:');
$uri->query_form( ref $args{data} eq "HASH" ? %{ $args{data} } : @{ $args{data} } );
$data = $uri->query;
$data =~ s/(?<!%0D)%0A/%0D%0A/g if defined $data;
}
}
return $data;
}
sub _decode {
my ( $self, %args ) = @_;
my ( $data );
for ( $args{type} ) {
when ( 'json' ) {
$data = $self->_json->decode( $args{data} );
}
when ( 'xml' ) {
$data = $self->_xml->parse( $args{data} );
}
}
return $data;
}
sub _bytes {
my ( $self, $data ) = @_;
return length $data;
}
# A method that will let us write readable requests insteadOfCamelCase.
# Helpful for Google SOAP APIs. See ./t/02-google-dfp.t for example.
sub _camelize {
my $self = shift;
my $data = shift;
$data->{ lcfirst camelize $_ } = delete $data->{ $_ } for keys %{ $data };
for my $data ( values %{ $data } ) {
for ( ref $data ) {
when ( 'ARRAY' ) {
for my $data ( @{ $data } ) {
$self->_camelize( $data ) if ref $data eq 'HASH';
}
}
when ( 'HASH' ) {
$self->_camelize( $data );
}
}
}
}
sub _decamelize {
my $self = shift;
my $data = shift;
my %args = @_;
delete $data->{ $_ } # delete -xmlns and other attrs... why not?
for grep { $_ =~ /^-/ } keys %{ $data };
for ( keys %{ $data } ) {
$data->{ decamelize $_ } = delete $data->{ $_ };
}
for my $data ( values %{ $data } ) {
for ( ref $data ) {
when ( 'ARRAY' ) {
for my $data ( @{ $data } ) {
$self->_decamelize( $data, %args ) if ref $data eq 'HASH';
}
}
when ( 'HASH' ) {
$self->_decamelize( $data, %args );
}
}
}
}
sub _join_uri {
my ( $self, @path ) = @_;
my ( $base ) = ( $self->uri );
@path = map { $_ =~ s/^\///; $_ =~ s/\/$//; $_ } @path;
lib/API/Handle.pm view on Meta::CPAN
=head1 NAME
API::Handle
=head1 VERSION
version 0.02
=head3 _tied
Recursively tie \[ key => $val, key => $val, ... ] data to create preserved-order hashes ( needed for SOAP ).
=head1 AUTHOR
Nour Sharabash <amirite@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Nour Sharabash.
This is free software; you can redistribute it and/or modify it under
lib/API/Handle/Google/DFP.pm view on Meta::CPAN
if ( $conf->{auth}{token}{access_token} and $conf->{auth}{token}{expires_at} and $conf->{auth}{token}{expires_at} > $time ) {
$self->ua->default_header( 'Authorization' => "$conf->{auth}{token}{token_type} $conf->{auth}{token}{access_token}" );
}
elsif ( $conf->{auth}{token}{refresh_token} ) {
my $req = new HTTP::Request;
$req->headers->header( 'Content-Type' => 'application/x-www-form-urlencoded' );
$req->method( 'POST' );
$req->uri( $conf->{auth}{uri}{token} );
my $data = $self->_encode( type => 'form', data => {
grant_type => 'refresh_token'
, client_id => $conf->{auth}{client}{id}
, client_secret => $conf->{auth}{client}{secret}
, refresh_token => $conf->{auth}{token}{refresh_token}
} );
$req->content( $data );
my $res = $self->ua->request( $req );
if ( $res->code == 200 ) {
my $data = $self->_decode( type => 'json', data => $res->content );
$data->{expires_at} = time + $data->{expires_in};
$self->merge_config( $conf->{auth}->{token}, $data );
$self->write_config( 'config/google/dfp/auth/private/token.yml', $conf->{auth}->{token} );
}
}
if ( $conf->{auth}{token}{access_token} and $conf->{auth}{token}{expires_at} and $conf->{auth}{token}{expires_at} > $time ) {
$self->ua->default_header( 'Authorization' => "$conf->{auth}{token}{token_type} $conf->{auth}{token}{access_token}" );
}
else {
carp 'no access token';
}
# Setup match-spec vars for request_prepare.
my ( $scheme, $host, $path ) = $self->uri =~ /^(https?):\/\/([^\/]+)(\/.+)$/;
# Add request wrapper.
$self->ua->add_handler(
request_prepare => sub {
my ( $req, $ua, $h ) = @_;
# Create SOAP envelope.
if ( my $data = $req->content ) {
$self->_camelize( $data );
$data = {
'soap:Envelope' => {
'-xmlns' => $self->uri
, '-xmlns:soap' => 'http://schemas.xmlsoap.org/soap/envelope/'
, '-xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance'
, 'soap:Header' => {
'RequestHeader' => {
'networkCode' => $conf->{network_code}
,'applicationName' => $conf->{application_name}
}
}
, 'soap:Body' => $data
}
};
my $xml = $self->_xml->write( $data );
$req->content( $xml );
$req->headers->header( 'Content-Type' => 'text/xml; charset=utf-8' );
# Uncomment this to view generated SOAP xml/envelope.
# $self->debug( $xml );
}
}
, m_scheme => $scheme
, m_host => $host
, m_path_match => qr/^\Q$path\E/
);
# Add response wrapper.
$self->ua->add_handler(
response_done => sub {
my ( $res, $ua, $h ) = @_;
if ( my $data = $res->content ) {
$data = $self->_xml->parse( $data );
$data = delete $data->{ 'soap:Envelope' }{ 'soap:Body' };
$self->_decamelize( $data );
$res->content( $data );
}
}
, m_scheme => $scheme
, m_host => $host
, m_path_match => qr/^\Q$path\E/
, m_code => 200
, m_media_type => 'text/xml'
);
return $prev;
lib/API/Handle/OpenX.pm view on Meta::CPAN
# Setup match-spec vars for request_prepare.
my ( $scheme, $host, $path ) = $self->uri =~ /^(https?):\/\/([^\/]+)(\/.+)$/;
# Add request wrapper.
$self->ua->add_handler(
request_prepare => sub {
my ( $req, $ua, $h ) = @_;
# Create SOAP envelope.
if ( my $data = $req->content ) {
my $json = $self->_encode( type => 'json', data => $data );
$req->content( $json );
$req->headers->header( 'Content-Type' => 'application/json; charset=utf-8' );
# Uncomment this to view generated JSON content.
# $self->debug( $json );
}
}
, m_scheme => $scheme
, m_host => $host
, m_path_match => qr/^\Q$path\E/
);
# Add response wrapper.
$self->ua->add_handler(
response_done => sub {
my ( $res, $ua, $h ) = @_;
if ( my $data = $res->content ) {
$data = $self->_decode( type => 'json', data => $data );
$res->content( $data );
}
}
, m_scheme => $scheme
, m_host => $host
, m_path_match => qr/^\Q$path\E/
, m_code => 200
);
return $prev;
};
( run in 0.324 second using v1.01-cache-2.11-cpan-0d8aa00de5b )