view Lib/IMPL/Web/Application/RestBaseResource.pm @ 201:0c018a247c8a

Reworked REST resource classes to be more transparent and intuitive
author sergey
date Tue, 24 Apr 2012 19:52:07 +0400
parents a9dbe534d236
children 5146e17a7b76
line wrap: on
line source

package IMPL::Web::Application::RestBaseResource;
use strict;

use IMPL::lang qw(:declare :constants);
use IMPL::declare {
	require => {
		Exception => 'IMPL::Exception',
		ArgumentException => '-IMPL::InvalidArgumentException',
		NotImplException => '-IMPL::NotImplementedException',
		ForbiddenException => 'IMPL::Web::ForbiddenException',
		TTransform => '-IMPL::Transform',
        TResolve => '-IMPL::Config::Resolve'
	},
    base => {
        'IMPL::Object' => undef,
        'IMPL::Object::Autofill' => '@_'
    }
};


BEGIN {
    public property id => PROP_GET | PROP_OWNERSET;
    public property parent => PROP_GET | PROP_OWNERSET;
    public property contract => PROP_GET | PROP_OWNERSET;
    protected property final => PROP_ALL;
}

sub target {
	shift;
}

sub CTOR {
    my ($this) = @_;
    
    die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
    die ArgumentException->new("A contract is required") unless $this->contract;
}

sub GetHttpImpl {
    my($this,$method) = @_;
    
    my %map = (
        GET => 'GetImpl',
        PUT => 'PutImpl',
        POST => 'PostImpl',
        DELETE => 'DeleteImpl'
    );
    
    return $map{$method};
}

sub InvokeHttpMethod {
    my ($this,$method,$action) = @_;
    
    my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
    
    return $this->$impl($action);
}

sub GetImpl {
	die NotImplException->new();
}

sub PutImpl {
    die NotImplException->new();
}

sub PostImpl {
    die NotImplException->new();
}

sub DeleteImpl {
    die NotImplException->new();
}

sub HttpFallbackImpl {
    die ForbiddenException->new();
}

sub FetchChildResource {
	return undef;
}

sub InvokeMember {
    my ($this,$method,$action) = @_;
    
    die ArgumentException->new("method","No method information provided") unless $method;
    
    #normalize method info
    if (not ref $method) {
        $method = {
            method => $method
        };
    }
    
    if (ref $method eq 'HASH') {
        my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
        
        my @args;
    
        if (my $params = $method->{parameters}) {
            if (ref $params eq 'HASH') {
                @args = map {
                    $_,
                    $this->MakeParameter($params->{$_},$action)
                } keys %$params;                
            } elsif (ref $params eq 'ARRAY') {
                @args = map $this->MakeParameter($_,$action), @$params;
            } else {
                @args = ($this->MakeParameter($params,$action)); 
            }
        }
        return $this->target->$member(@args);
    } elsif (ref $method eq TResolve) {
        return $method->Invoke($this->target);
    } elsif (ref $method eq 'CODE') {
        return $method->($this,$action);
    } else {
        die InvalidOpException->new("Unsupported type of the method information", ref $method);
    }
}

sub MakeParameter {
    my ($this,$param,$action) = @_;
    
    if ($param) {
        if (is $param, TTransform ) {
            return $param->Transform($this,$action->query);
        } elsif ($param and not ref $param) {
            return $action->query->param($param);
        } else {
        	die new InvalidOpException->new("Unsupported parameter mapping", $param);
        }
    } else {
        return undef;
    }
}


1;

__END__

=pod



=cut