view release on metacpan or  search on metacpan

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

        LOGDIE "Error loading $objclass : $@" unless $@ =~ /Can't locate/i;
    }

    $objclass = 'Clustericious::Client::Object' unless $objclass->can('new');

    Clustericious::Client::Meta->add_object(scalar caller(),$objname,$doc);

    no strict 'refs';
    *{"${caller}::$objname"} = sub {
        my $self = shift;
        my $meta = Clustericious::Client::Meta::Route->new(
            client_class => $caller,
            route_name   => $objname
        );
        $meta->set( quiet_post => 1 );
        my $data = $self->_doit( $meta, GET => $url, @_ );
        $objclass->new( $data, $self );
    };
    *{"${caller}::${objname}_delete"} = sub {
        my $meta = Clustericious::Client::Meta::Route->new(
            client_class => $caller,
            route_name   => $objname.'_delete',
        );
        $meta->set(dont_read_files => 1);
        shift->_doit( $meta, DELETE => $url, @_ );
    };
    *{"${caller}::${objname}_search"} = sub {
        my $meta = Clustericious::Client::Meta::Route->new(
            client_class => $caller,
            route_name   => $objname.'_search'
        );
        $meta->set(dont_read_files => 1);
        shift->_doit( $meta, POST => "$url/search", @_ );
    };
}

sub _doit {
    my $self = shift;
    my $meta;
    $meta = shift if ref $_[0] eq 'Clustericious::Client::Meta::Route';
    my ($method, $url, @args) = @_;

    my $auto_failover;
    $auto_failover = 1 if $meta && $meta->get('auto_failover');

    $url = $self->server_url . $url if $self->server_url && $url !~ /^http/;
    return undef if $self->server_url eq 'http://0.0.0.0';

    my $cb;
    my $body = '';
    my $headers = {};

    if ($method eq 'POST' && grep /^--/, @args) {
        s/^--// for @args;
        @args = ( { @args } );
    }

    $url = Mojo::URL->new($url) unless ref $url;
    my $parameters = $url->query;

    # Set up mappings from parameter names to modifier callbacks.
    my %url_modifier;
    my %payload_modifer;
    my %gen_url_modifier = (
        query  => sub { my $name = shift;
            sub { my ($u,$v) = @_; $u->query({$name => $v}) }  },
        append => sub { my $name = shift;
            sub { my ($u,$v) = @_; push @{ $u->path->parts } , $v; $u; } },
    );
    my %gen_payload_modifier = (
        array => sub {
            my ( $name, $key ) = @_;
            LOGDIE "missing key for array payload modifier" unless $key;
            sub { my $body = shift; $body ||= {}; push @{ $body->{$key} }, ( $name => shift ); $body; }
        },
        hash => sub {
            my $name = shift;
            sub { my $body = shift; $body ||= {}; $body->{$name} = shift; $body; }
        },
    );
    if ($meta && (my $arg_spec = $meta->get('args'))) {
        for (@$arg_spec) {
            my $name = $_->{name};
            if (my $modifies_url = $_->{modifies_url}) {
                $url_modifier{$name} =
                    ref($modifies_url) eq 'CODE'            ? $modifies_url
                 :  ($a = $gen_url_modifier{$modifies_url}) ? $a->($name)
                 :  die "don't understand how to interpret modifies_url=$modifies_url";
            }
            if (my $modifies_payload = $_->{modifies_payload}) {
                 $payload_modifer{$name} =
                    ref($modifies_payload) eq 'CODE' ? $modifies_payload
                 : ($a = $gen_payload_modifier{$modifies_payload}) ? $a->($name,$_->{key})
                 : LOGDIE "don't understand how to interpret modifies_payload=$modifies_payload";
            }
        }
    }

    while (defined(my $arg = shift @args)) {
        if (ref $arg eq 'HASH') {
            $method = 'POST';
            $parameters->append(skip_existing => 1) if $meta && $meta->get("skip_existing");
            $body = encode_json $arg;
            $headers = { 'Content-Type' => 'application/json' };
        } elsif (ref $arg eq 'CODE') {
            $cb = $self->_mycallback($arg);
        } elsif (my $code = $url_modifier{$arg}) {
            $url = $code->($url, shift @args);
        } elsif (my $code2 = $payload_modifer{$arg}) {
            $body = $code2->($body, shift @args);
        } elsif ($method eq "GET" && $arg =~ s/^--//) {
            my $value = shift @args;
            $parameters->append($arg => $value);
        } elsif ($method eq "GET" && $arg =~ s/^-//) {
            # example: $client->esdt(-range => [1 => 100]);
            my $value = shift @args;
            if (ref $value eq 'ARRAY') {
                $value = "items=$value->[0]-$value->[1]";
            }
            $headers->{$arg} = $value;
        } elsif ($method eq "POST" && !ref $arg) {