File Coverage

blib/lib/WWW/BigDoor/Resource.pm

Criterion	Covered	Total	%
statement	77	77	100.0
branch	18	22	81.8
condition	3	6	50.0
subroutine	13	13	100.0
pod	6	6	100.0
total	117	124	94.3

package WWW::BigDoor::Resource;

use strict;
use warnings;
use Carp;

#use Smart::Comments -ENV;

use base qw(Class::Accessor);

__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors(
    qw(created_timestamp modified_timestamp pub_title pub_description end_user_title end_user_description resource_name)
);

sub new {
    my ( $class, $args ) = @_;

    ## new...
    my $self = {};
    ## args: $args
    ### check: ref( $args ) eq 'HASH'

    foreach my $k ( keys %{$args} ) {
        ## key: $k
        ## val: $args->{$k}
        # FIXME restrict allowed key names
        $self->{$k} = $args->{$k};
    }

    bless( $self, $class );
    return $self;
}

sub end_point {
    my ( $self ) = @_;

    my $ep = $self->_end_point;

    if ( $self->_parent_end_point() ) {
        $ep = sprintf '%s/%s/%s',
          $self->_parent_end_point(),
          $self->{$self->_parent_id_attr},
          $self->_end_point();
        ###  ep with parent: $ep
    }
    return $ep;
}

sub all {
    my ( $self, $client ) = @_;
    my $ep = $self->end_point();

    ## end_point: $ep
    ### check: defined $ep
    my $data = $client->GET( $ep );
    my @all;

    ### data: $data

    foreach my $object ( @{@$data[0]} ) {
        ### object: $object
        push @all, $self->new( $object );
        ### next...
    }
    return [@all];
}

sub load {
    my ( $self, $client, $id ) = @_;

    if ( !defined $id && !ref $self ) {
        croak "Should pass object ID\n";
    }
    my $ep = $self->_end_point();

    ## end_point: $ep

    $id = $self->get_id unless defined $id;

    ### check: defined $ep
    ### check: defined $id
    ### end_point: sprintf '%s/%s', $ep, $id
    my $data = $client->GET( sprintf '%s/%s', $ep, $id );

    ### data: $data
    ### check: defined $data

    if ( ref $self ) {
        foreach my $k ( keys %{$data->[0]} ) {
            ## key: $k
            ## val: $args->{$k}
            # FIXME restrict allowed key names
            $self->{$k} = $data->[0]->{$k};
        }
        return $self;
    }

    return $self->new( @$data[0] );
} ## end sub load

sub save {
    my ( $self, $client ) = @_;

    my $ep = $self->end_point();

    ### end_point: $ep
    ### check: defined $ep

    my $payload;
    foreach my $k ( keys %{$self} ) {
        next if ref $self->{$k};
        $payload->{$k} = $self->{$k};
    }

    my $result;

    if ( defined $self->get_id ) {
        $result =
          $client->PUT( sprintf( '%s/%s', $ep, $self->get_id ), {format => 'json'}, $payload );
    }
    else {
        $result = $client->POST( $ep, {format => 'json'}, $payload );
    }
    ### result: $result->[0]
    foreach my $k ( keys %{$result->[0]} ) {
        ## key: $k
        ## val: $args->{$k}
        # FIXME restrict allowed key names
        $self->{$k} = $result->[0]{$k};
    }
    return $self;
} ## end sub save

sub remove {
    my ( $self, $client, $id ) = @_;

    ### remove...
    use Data::Dumper;
    ### self: Dumper( $self )
    my $ep = $self->end_point();

    ### check: defined $ep

    ### check: defined $id
    $id = $self->get_id if ( ref $self && !defined $id );

    ### ref: ref $self
    ### check: defined $id
    ### end_point: sprintf '%s/%s', $ep, $id

    $client->DELETE( sprintf '%s/%s', $ep, $id );
    return;
}

sub _parent_end_point {
    return;
}

sub _end_point {
    my ( $self ) = @_;

    croak "Need object or class named" unless defined $self;

    $self = ref $self if ref $self;

    ### self1: $self

    if ( $self =~ /WWW::BigDoor::(\w+)/x ) {
        $self = $1;
    }

    $self =~ s/([A-Z]+)([A-Z][a-z])/$1_$2/xg;
    $self =~ s/([a-z\d])([A-Z])/$1_$2/xg;

    confess "Can\'t detect class name $self" unless defined $self;

    return lc $self;
}

1;
__END__