File Coverage

blib/lib/CouchDB/Client.pm

Criterion	Covered	Total	%
statement	54	78	69.2
branch	7	18	38.8
condition	3	14	21.4
subroutine	13	17	76.4
pod	9	9	100.0
total	86	136	63.2

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 which specifies the server's URI;
C, C, C which are used if C isn't provided and default to 'http',
'localhost', and '5984' respectively; C 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 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.

=item serverInfo

Returns a hashref of the server metadata, typically something that looks like
C<<< { couchdb => "Welcome", version => "0.8.0-incubating"} >>>. It throws
an exception if it can't connect.

=item newDB $NAME

Returns a new C object for a database of that name. Note that the DB
does not need to exist yet, and will not be created if it doesn't.

=item listDBNames

Returns an arrayref of all the database names that the server knows of. Throws an exception
if it cannot connect.

=item listDBs

Same as above but returns an arrayref of C objects instead.

=item dbExists $NAME

Returns true if a database of that name exists, false otherwise.

=back

=head1 INTERNAL METHODS

You will use these at your own risk

=over 8

=item req $METHOD, $PATH, $CONTENT

$METHOD is the HTTP method to use; $PATH the part of the path that follows C;
and $CONTENT a Perl data structure. The latter, if present, is encoded to JSON and the request
is made using the given method and path. The return value is a hash containing a boolean indicating
C, a C being the HTTP response code, a descriptive C, and a C field
containing the response JSON.

=item uriForPath $PATH

Gets a path and returns the complete URI.

=back

=head1 AUTHOR

Robin Berjon,
Maverick Edwards,  (current maintainer)

=head1 BUGS

Please report any bugs or feature requests to bug-couchdb-client at rt.cpan.org, or through the
web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CouchDB-Client.

=head1 COPYRIGHT & LICENSE

Copyright 2008 Robin Berjon, all rights reserved.

This library is free software; you can redistribute it and/or modify it under the same terms as
Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may
have available.

=cut