API-Handle

 view release on metacpan or  search on metacpan

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 0.249 second using v1.01-cache-2.11-cpan-4d50c553e7e )