view release on metacpan or  search on metacpan

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

		 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
			( 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;

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

		when ( 'ARRAY' ) {
			for my $index ( 0 .. $#{ $ref } ) {
				my $val = $ref->[ $index ];
				$self->_tied( ref => $ref, index => $index ) if grep { ref $val eq $_ } qw/ARRAY HASH REF/;
			}

			$tied = 1 if $args{tied}; # i.e. $args{content} from $self->req routine
		}
		when ( 'HASH' ) {
			for my $key ( keys %{ $ref } ) {
				my $val = $ref->{ $key };
				$self->_tied( ref => $ref, key => $key ) if grep { ref $val eq $_ } qw/ARRAY HASH REF/;
			}
		}
	}

	if ( $tied ) {
		tie my %hash, 'Tie::Hash::Indexed';

		for ( ref $ref ) {
			when ( 'ARRAY' ) {
				@array = @{ $ref };
			}
			when ( 'REF' ) {
				@array = @{ ${ $ref } };
			}
		}

		%hash = @array;

		for ( ref $args{ref} ) {
			when ( 'HASH' ) {
				$args{ref}->{ $args{key} } = \%hash;
			}
			when ( 'ARRAY' ) {
				$args{ref}->[ $args{index} ] = \%hash;
			}
			when ( 'REF' ) {
				${ $args{ref} }->[ $args{index} ] = \%hash;
			}
		}
	}
}

1;

__END__

=pod

=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
the same terms as the Perl 5 programming language system itself.

=cut