view release on metacpan or  search on metacpan

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

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