Net::FluidDB::Object - FluidDB objects

 use Net::FluidDB::Object;

 # create, with optional about
 $object = Net::FluidDB::Object->new(
     fdb   => $fdb,
     about => $unique_about
 );
 $object->create;
 $object->id; # returns the object's ID in FluidDB

 # get by ID, optionally fetching about
 $object = Net::FluidDB::Object->get_by_id($fdb, $id, about => 1);

 # get by about
 $object = Net::FluidDB::Object->get_by_about($fdb, $about);

 # tag
 $object->tag("fxn/likes");
 $object->tag("fxn/rating", integer => 10);
 $object->tag("fxn/avatar", 'image/png' => $image);

 # retrieve a tag value
 $value = $object->value("fxn/rating");

 # retrieve a tag value and its type
 ($type, $value) = $object->value("fxn/rating");

 # remove a tag
 $object->untag("fxn/rating");

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

package Net::FluidDB::Object;
use Moose;
extends 'Net::FluidDB::Base';

use Carp;
use Scalar::Util qw(blessed);
use Net::FluidDB::Tag;
use Net::FluidDB::Value;
use Net::FluidDB::Value::Native;
use Net::FluidDB::Value::NonNative;
use Net::FluidDB::Value::Null;
use Net::FluidDB::Value::Boolean;
use Net::FluidDB::Value::Integer;
use Net::FluidDB::Value::Float;
use Net::FluidDB::Value::String;
use Net::FluidDB::Value::Set;

has id        => (is => 'ro', isa => 'Str', writer => '_set_id', predicate => 'has_id');
has about     => (is => 'rw', isa => 'Str', predicate => 'has_about');
has tag_paths => (is => 'ro', isa => 'ArrayRef[Str]', writer => '_set_tag_paths', default => sub { [] });

sub create {
    my $self = shift;

    my $payload = $self->has_about ? $self->json->encode({about => $self->about}) : undef;
    $self->fdb->post(
        path       => $self->abs_path('objects'),
        headers    => $self->fdb->headers_for_json,
        payload    => $payload,
        on_success => sub {
            my $response = shift;
            my $h = $self->json->decode($response->content);
            $self->_set_id($h->{id});
            # Unset tag paths to force fetching the about tag.
            $self->_set_tag_paths(['fluiddb/about']) if $self->has_about;
            1;
        }
    );
}

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

sub get_by_id {
    my ($class, $fdb, $id, %opts) = @_;

    $opts{showAbout} = $class->true if delete $opts{about};
    $fdb->get(
        path       => $class->abs_path('objects', $id),
        query      => \%opts,
        headers    => $fdb->accept_header_for_json,
        on_success => sub {
            my $response = shift;
            my $h = $class->json->decode($response->content);
            my $o = $class->new(fdb => $fdb, %$h);
            $o->_set_id($id);
            $o->_set_tag_paths($h->{tagPaths});
            $o;
        }
    );
}

sub get_by_about {
    my ($class, $fdb, $about) = @_;
    $fdb->get(
        path       => $class->abs_path('/about', $about),
        headers    => $fdb->accept_header_for_json,
        on_success => sub {
            my $response = shift;
            my $h = $class->json->decode($response->content);
            my $o = $class->new(fdb => $fdb);
            $o->_set_id($h->{id});
            $o->_set_tag_paths($h->{tagPaths});
            $o->about($about);
            $o;
        }
    );
}

sub search {
    my ($class, $fdb, $query) = @_;

    my %params = (query => $query);
    $fdb->get(
        path       => '/objects',
        query      => \%params,
        headers    => $fdb->accept_header_for_json,
        on_success => sub {
            my $response = shift;
            @{$class->json->decode($response->content)->{ids}};
        }
    );
}

sub tag {
    my ($self, $tag_or_tag_path, @rest) = @_;

    my $tag_path = $self->get_tag_path_from_tag_or_tag_path($tag_or_tag_path);
    if (@rest < 2) {
        $self->tag_fdb_value_or_scalar($tag_path, @rest);
    } elsif (@rest == 2) {
        $self->tag_fdb_value_or_scalar_with_options($tag_path, @rest);
    } else {
        croak "invalid call to Object->tag()";
    }
}

sub has_tag {
    my ($class, $fdb, $object_id, $tag_or_tag_path) = @_;

    my $tag_path = $class->get_tag_path_from_tag_or_tag_path($tag_or_tag_path);
    $fdb->head(
        path       => $class->abs_path('/objects', $object_id, $tag_path),
        on_success => sub { 1 },
        on_failure => sub {
            my $response = shift;

            if ($response->code == 404) {
                0;
            } else {
                # Can be a 401 if permissions disallow this test. Do this as we
                # do elsewhere until we get proper support for failures.
                print STDERR $response->as_string;
                0;
            }
        }
    );
}

sub tag_fdb_value_or_scalar {
    my ($self, $tag_path, $value) = @_;

    if (defined $value) {
        if (ref $value) {
            if (ref $value eq 'ARRAY') {
                $value = Net::FluidDB::Value::Set->new(value => $value);
            } elsif (blessed $value && $value->isa('Net::FluidDB::Value')) {
                # fine, do nothing
            } else {
                croak "$value is not undef nor a valid reference for tagging\n";
            }
        } else {
            croak "$value is not undef nor a valid reference for tagging\n";
        }
    } else {
        $value = Net::FluidDB::Value::Null->new;
    }
    $self->tag_fdb_value($tag_path, $value);
}

sub tag_fdb_value_or_scalar_with_options {
    my ($self, $tag_path, $type, $value) = @_;

    my $native_type = Net::FluidDB::Value::Native->type_from_alias($type);
    $value = $native_type ?
             $native_type->new(value => $value) :
             Net::FluidDB::Value::NonNative->new(value => $value, mime_type => $type);
    $self->tag_fdb_value($tag_path, $value);
}

sub tag_fdb_value {
    my ($self, $tag_path, $value) = @_;

    my $status = $self->fdb->put(
        path    => $self->abs_path('objects', $self->id, $tag_path),
        headers => {'Content-Type' => $value->mime_type},
        payload => $value->payload
    );

    if ($status && !$self->is_tag_path_present($tag_path)) {
        push @{$self->tag_paths}, $tag_path;
    }

    $status;
}

sub value {
    my ($self, $tag_or_tag_path, @rest) = @_;
    my $list_context = wantarray;

    my $tag_path = $self->get_tag_path_from_tag_or_tag_path($tag_or_tag_path);
    $self->fdb->get(
        path       => $self->abs_path('objects', $self->id, $tag_path),
        on_success => sub {
            my $response = shift;
            my $value_object = Net::FluidDB::Value->new_from_mime_type_and_content(
                $response->headers->header('Content-Type'),
                $response->content
            );
            $list_context ? ($value_object->type, $value_object->value) : $value_object->value;
        }
    );
}

sub get_tag_path_from_tag_or_tag_path {
    my $tag_or_tag_path = $_[1];
    ref($tag_or_tag_path) ? $tag_or_tag_path->path : $tag_or_tag_path;
}

sub is_tag_path_present {
    my ($self, $tag_path) = @_;

    foreach my $known_tag_path (@{$self->tag_paths}) {
        return 1 if Net::FluidDB::HasPath->equal_paths($tag_path, $known_tag_path);
    }
    return 0;
}

sub untag {
    my ($self, $tag_or_tag_path) = @_;

    my $tag_path = $self->get_tag_path_from_tag_or_tag_path($tag_or_tag_path);
    $self->fdb->delete(
        path       => $self->abs_path('objects', $self->id, $tag_path),
        on_success => sub {
            my @rest = grep { !Net::FluidDB::HasPath->equal_paths($tag_path, $_) } @{$self->tag_paths};
            $self->_set_tag_paths(\@rest);
            1;
        }
    );
}

no Moose;
__PACKAGE__->meta->make_immutable;

1;

__END__