view release on metacpan or  search on metacpan

lib/CouchDB/Client.pm  view on Meta::CPAN

package CouchDB::Client;

use strict;
use warnings;

our $VERSION = '0.09';

use JSON::Any       qw(XS JSON DWIW);
use LWP::UserAgent  qw();
use HTTP::Request   qw();
use Encode          qw(encode);
use Carp            qw(confess);

use CouchDB::Client::DB;

sub new {
	my $class = shift;
	my %opt = @_ == 1 ? %{$_[0]} : @_;

	my %self;
	if ($opt{uri}) {
		$self{uri} = $opt{uri};
		$self{uri} .= '/' unless $self{uri} =~ m{/$};
	}
	else {
		$self{uri} = ($opt{scheme} || 'http')      . '://' .
					 ($opt{host}   || 'localhost') . ':'   .
					 ($opt{port}   || '5984')      . '/';
	}
	$self{json} = ($opt{json} || JSON::Any->new(utf8 => 1, allow_blessed => 1));
	$self{ua}   = ($opt{ua}   || LWP::UserAgent->new(agent => "CouchDB::Client/$VERSION"));

	return bless \%self, $class;
}

sub testConnection {
	my $self = shift;
	eval { $self->serverInfo; };
	return 0 if $@;
	return 1;
}

sub serverInfo {
	my $self = shift;
	my $res = $self->req('GET');
	return $res->{json} if $res->{success};
	confess("Connection error: $res->{msg}");
}

sub newDB {
	my $self = shift;
	my $name = shift;
	return CouchDB::Client::DB->new(name => $name, client => $self);
}

sub listDBNames {
	my $self = shift;
	my $res = $self->req('GET', '_all_dbs');
	return $res->{json} if $res->{success};
	confess("Connection error: $res->{msg}");
}

sub listDBs {
	my $self = shift;
	return [ map { $self->newDB($_) } @{$self->listDBNames} ];
}

sub dbExists {
	my $self = shift;
	my $name = shift;
	$name =~ s{/$}{};
	return (grep { $_ eq $name } @{$self->listDBNames}) ? 1 : 0;
}

# --- CONNECTION HANDLING ---
sub req {
	my $self = shift;
	my $meth = shift;
	my $path = shift;
	my $content = shift;
	my $headers = undef;

	if (ref $content) {
		$content = encode('utf-8', $self->{json}->encode($content));
        $headers = HTTP::Headers->new('Content-Type' => 'application/json');
	}
	my $res = $self->{ua}->request( HTTP::Request->new($meth, $self->uriForPath($path), $headers, $content) );
	my $ret = {
		status  => $res->code,
		msg     => $res->status_line,
		success => 0,
	};
	if ($res->is_success) {
		$ret->{success} = 1;
		$ret->{json} = $self->{json}->decode($res->content);
	}
	return $ret;
}

# --- HELPERS ---
sub uriForPath {
	my $self = shift;
	my $path = shift() || '';
	return $self->{uri} . $path;
}


1;

=pod

=head1 NAME

CouchDB::Client - Simple, correct client for CouchDB

=head1 SYNOPSIS

	use CouchDB::Client;
	my $c = CouchDB::Client->new(uri => 'https://dbserver:5984/');
	$c->testConnection or die "The server cannot be reached";
	print "Running version " . $c->serverInfo->{version} . "\n";
	my $db = $c->newDB('my-stuff')->create;

	# listing databases
	$c->listDBs;
	$c->listDBNames;


=head1 DESCRIPTION

This module is a client for the CouchDB database.

=head1 METHODS

=over 8

=item new

Constructor. Takes a hash or hashref of options: C<uri> which specifies the server's URI;
C<scheme>, C<host>, C<port> which are used if C<uri> isn't provided and default to 'http',
'localhost', and '5984' respectively; C<json> which defaults to a JSON::Any object with
utf8 and allow_blessed turned on but can be replaced with anything with the same interface;
and C<ua> which is a LWP::UserAgent object and can also be replaced.

=item testConnection

Returns true if a connection can be made to the server, false otherwise.