Net::FluidDB - A Perl interface to FluidDB

 use Net::FluidDB;

 # Predefined FluidDB client for playing around, points
 # to the sandbox with user test/test
 $fdb = Net::FluidDB->new_for_testing;
 $fdb = Net::FluidDB->new_for_testing(trace_http => 1);

 # FluidDB client pointing to production
 $fdb = Net::FluidDB->new(username => 'username', password => 'password');

 # FluidDB taking credentials from environment variables
 # FLUIDDB_USERNAME and FLUIDDB_PASSWORD
 $fdb = Net::FluidDB->new;

 # Content-MD5 headers with checksums for requests with payload
 $fdb = Net::FluidDB->new(md5 => 1)

 # Resource getters
 $object     = $fdb->get_object_by_id($id, about => 1);
 $object     = $fdb->get_object_by_about($about);
 $ns         = $fdb->get_namespace($path, description => 1);
 $tag        = $fdb->get_tag($path, description => 1);
 $policy     = $fdb->get_policy($user, $category, $action);
 $permission = $fdb->get_permission($category, $path, $action);
 $user       = $fdb->get_user($username);

 # Object search
 @ids = $fdb->search("has fxn/rating");

package Net::FluidDB;
use Moose;

use LWP::UserAgent;
use HTTP::Request;
use URI;
use Digest::MD5 'md5_base64';

use Net::FluidDB::Object;
use Net::FluidDB::Namespace;
use Net::FluidDB::Tag;
use Net::FluidDB::Policy;
use Net::FluidDB::Permission;
use Net::FluidDB::User;

our $VERSION           = '0.30';
our $USER_AGENT        = "Net::FluidDB/$VERSION ($^O)";
our $DEFAULT_PROTOCOL  = 'HTTP';
our $DEFAULT_HOST      = 'fluiddb.fluidinfo.com';
our $SANDBOX_HOST      = 'sandbox.fluidinfo.com';
our $JSON_CONTENT_TYPE = 'application/json';

has protocol => (is => 'rw', isa => 'Str', default => $DEFAULT_PROTOCOL);
has host     => (is => 'rw', isa => 'Str', default => $DEFAULT_HOST);
has username => (is => 'rw', isa => 'Maybe[Str]', default => sub { $ENV{FLUIDDB_USERNAME} });
has password => (is => 'rw', isa => 'Maybe[Str]', default => sub { $ENV{FLUIDDB_PASSWORD} });
has ua       => (is => 'ro', isa => 'LWP::UserAgent', writer => '_set_ua');
has user     => (is => 'ro', isa => 'Net::FluidDB::User', lazy_build => 1);
has md5      => (is => 'rw', isa => 'Bool');

sub BUILD {
    my ($self, $attrs) = @_;

    my $ua = LWP::UserAgent->new(agent => $USER_AGENT);
    if ($attrs->{trace_http} || $attrs->{trace_http_requests}) {
        $ua->add_handler("request_send",  sub { shift->dump; return });
    }
    if ($attrs->{trace_http} || $attrs->{trace_http_responses}) {
        $ua->add_handler("response_done",  sub { shift->dump; return });
    }
    $self->_set_ua($ua);
}

sub _build_user {
    my $self = shift;
    Net::FluidDB::User->get($self, $self->username);
}

sub new_for_testing {
    my ($class, %attrs) = @_;
    $class->new(username => 'test', password => 'test', host => $SANDBOX_HOST, %attrs);
}

sub _new_for_net_fluiddb_test_suite {
    my ($class, %attrs) = @_;
    $class->new(username => 'net-fluiddb', password => 'i98jijojijup92jo', %attrs);
}

sub get {
    shift->request("GET", @_);
}

sub post {
    shift->request("POST", @_);
}

sub head {
    shift->request("HEAD", @_);
}

sub put {
    shift->request("PUT", @_);
}

sub delete {
    shift->request("DELETE", @_);
}

sub request {
    my ($self, $method, %opts) = @_;

    my $request = HTTP::Request->new;
    $request->authorization_basic($self->username, $self->password);
    $request->method($method);
    $request->uri($self->uri_for(%opts));

    if (exists $opts{headers}) {
        while (my ($header, $value) = each %{$opts{headers}}) {
            $request->header($header => $value);
        }
    }

    if (defined $opts{payload}) {
        $request->content($opts{payload});
        if ($self->md5) {
            # md5_base64 returns a string with 22 characters, we add padding
            # up to the next multiple of 4 by hand.
            $request->header('Content-MD5' => md5_base64($request->content) . '==');
        }
    }

    my $response = $self->ua->request($request);
    if ($response->is_success) {
        if (exists $opts{on_success}) {
            $opts{on_success}->($response);
        } else {
            1;
        }
    } else {
        if (exists $opts{on_failure}) {
            $opts{on_failure}->($response);
        } else {
            print STDERR $response->as_string;
            0;
        }
    }
}

sub uri_for {
    my ($self, %opts) = @_;

    my $uri = URI->new;
    $uri->scheme(lc $self->protocol);
    $uri->host($self->host);
    $uri->path($opts{path});
    $uri->query_form($opts{query}) if exists $opts{query};
    $uri;
}

sub headers_for_json {
    return {
        'Accept'       => $JSON_CONTENT_TYPE,
        'Content-Type' => $JSON_CONTENT_TYPE
    };
}

sub accept_header_for_json {
    return {
        'Accept' => $JSON_CONTENT_TYPE
    }
}

sub content_type_header_for_json {
    return {
        'Content-Type' => $JSON_CONTENT_TYPE
    }
}

#
# -- Convenience shortcuts ----------------------------------------------------
#

sub get_object {
    print STDERR "get_object has been deprecated and will be removed, please use get_object_by_id instead\n";
    &get_object_by_id;
}

sub get_object_by_id {
    Net::FluidDB::Object->get_by_id(@_);
}

sub get_object_by_about {
    Net::FluidDB::Object->get_by_about(@_);
}

sub search {
    Net::FluidDB::Object->search(@_);
}

sub get_namespace {
    Net::FluidDB::Namespace->get(@_);
}

sub get_tag {
    Net::FluidDB::Tag->get(@_);
}

sub get_policy {
    Net::FluidDB::Policy->get(@_);
}

sub get_permission {
    Net::FluidDB::Permission->get(@_);
}

sub get_user {
    Net::FluidDB::User->get(@_);
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;


__END__