API-Handle

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    received the program in object code or executable form alone.)

Source code for a work means the preferred form of the work for making
modifications to it.  For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.

  4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License.  However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.

  5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.

  6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions.  You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.

  7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time.  Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.

Each version is given a distinguishing version number.  If the Program
specifies a version number of the license which applies to it and "any

LICENSE  view on Meta::CPAN

may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.

6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.

7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.

8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.

9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

The End

lib/API/Handle.pm  view on Meta::CPAN

use feature ':5.10';
use String::CamelCase qw/camelize decamelize/;
use Tie::Hash::Indexed;

has _config => (
	is => 'rw'
	, isa => 'Nour::Config'
	, handles => [ qw/config/ ]
	, required => 1
	, lazy => 1
	, default => sub {
		require Nour::Config;
		 return new Nour::Config ( -base => 'config' );
	}
);

has _printer => (
	is => 'rw'
	, isa => 'Nour::Printer'
	, handles => [ qw/verbose debug info warn warning error fatal dumper/ ]
	, required => 1
	, lazy => 1
	, default => sub {
		my $self = shift;
		my %conf = $self->config->{printer} ? %{ $self->config->{printer} } : (
			timestamp => 1
			, 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

has _json => (
	is => 'rw'
	, isa => 'JSON::XS'
	, lazy => 1
	, required => 1
	, default => sub {
		require JSON::XS;
		 return JSON::XS->new->utf8->ascii->relaxed;
	}
);

has _xml => (
	is => 'rw'
	, isa => 'XML::TreePP'
	, lazy => 1
	, required => 1
	, default => sub {
		require XML::TreePP;
		 return new XML::TreePP (
			output_encoding => 'UTF-8'
			, utf8_flag => 1
			, attr_prefix => '-'
			, indent => 2
			, use_ixhash => 1
		);
	}
);

has ua => (
	is => 'rw'
	, isa => 'LWP::UserAgent'
	, lazy => 1
	, required => 1
	, default => sub {
		require LWP::UserAgent;
		 return new LWP::UserAgent;
	}
);

has uri => (
	is => 'rw'
	, isa => 'Str'
	, required => 1
	, lazy => 1
	, default => sub { '' }
);

sub BUILD {
	my $self = shift;

	# Initialize attributes like 'uri' that may be set
	# in the configuration YAML.
	for my $attr ( keys %{ $self->config } ) {
		$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

lib/API/Handle.pm  view on Meta::CPAN

	# 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} );
		}

lib/API/Handle.pm  view on Meta::CPAN

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

lib/API/Handle.pm  view on Meta::CPAN

					$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;
	$base =~ s/\/$//;

	return join '/', $base, @path;
}


sub _tied {
	my ( $self, %args ) = @_;
	my ( @array, %hash, $ref, $tied );

	$ref = $args{ref}->{ $args{key} } if ref $args{ref} eq 'HASH';
	$ref = $args{ref}->[ $args{index} ] if ref $args{ref} eq 'ARRAY';
	$ref = ${ $args{ref} }->[ $args{index} ] if ref $args{ref} eq 'REF' and ref ${ $args{ref} } eq 'ARRAY';

	for ( ref $ref ) { # Recursion
		when ( 'REF' ) {
			if ( ref ${ $ref } eq 'ARRAY' ) { # \[]

lib/API/Handle/Google/DFP.pm  view on Meta::CPAN

has _config => (
	is => 'rw'
	, isa => 'Nour::Config'
	, handles => {
		  config => 'config'
		, merge_config => 'merge'
		, write_config => 'write'
	}
	, required => 1
	, lazy => 1
	, default => sub {
		my $self = shift;
		require Nour::Config;
		 return new Nour::Config (
			 -base => 'config/google/dfp'
		 );
	}
);

# This is where we configure how the user-agent transforms
# outgoing and incoming requests and responses.
# perldoc LWP::UserAgent.

around BUILD => sub {
	my ( $next, $self, @args, $prev ) = @_;

	# Put code that pre-empts API::Handle::BUILD before this $prev line.
	$prev = $self->$next( @args );
	# Put code that depends on API::Handle::BUILD after this $prev line.

	my $conf = $self->config;
	my $time = time;

	# Uncomment this to view loaded configuration.

lib/API/Handle/Google/DFP.pm  view on Meta::CPAN

	}
	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/'

lib/API/Handle/Google/DFP.pm  view on Meta::CPAN

				# $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

lib/API/Handle/OpenX.pm  view on Meta::CPAN

has _config => (
	is => 'rw'
	, isa => 'Nour::Config'
	, handles => {
		  config => 'config'
		, merge_config => 'merge'
		, write_config => 'write'
	}
	, required => 1
	, lazy => 1
	, default => sub {
		my $self = shift;
		require Nour::Config;
		 return new Nour::Config (
			 -base => 'config/openx'
		 );
	}
);

# This is where we configure how the user-agent transforms
# outgoing and incoming requests and responses.
# See also: API::Handle::Google::DFP.

around BUILD => sub {
	my ( $next, $self, @args, $prev ) = @_;

	my $conf = $self->config;

	$self->uri( $conf->{oauth}{api_url} );

	# Uncomment this to view loaded configuration.
	# $self->dumper( 'config', $conf );

	# Steal UA from lib provided by OpenX.

lib/API/Handle/OpenX.pm  view on Meta::CPAN


	# Put code that pre-empts API::Handle::BUILD before this $prev line.
	$prev = $self->$next( @args );
	# Put code that depends on API::Handle::BUILD after this $prev line.

	# 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



( run in 1.381 second using v1.01-cache-2.11-cpan-88abd93f124 )