REST.pm

package My::Base::REST;

use Moose;

BEGIN { extends 'Catalyst::Controller::REST'; }

use CGI::Expand qw/expand_hash/;

__PACKAGE__->config(
    'default' => 'text/html',
    map => {
        'text/html'  => [ 'View', 'TT' ],
        'text/xhtml' => [ 'View', 'TT' ],
        'text/xml'   => [ 'View', 'TT' ],
        'text/csv'   => [ 'View', 'REST::CSV' ],
    },
    update_string => 'Your object has been updated',
    create_string => 'Your object has been created',
    error_string  => 'Please correct the errors below.',
);

has 'order_by' => (
    is  => 'rw',
    isa => 'Str',
    default => ''
);

has 'prefetch' => (
    is  => 'rw',
    isa => 'ArrayRef|HashRef',
    default => sub { [] }
);

has 'create_string' => (
    is  => 'rw',
    isa => 'Str',
    default => 'Your object has been created'
);

has 'update_string' => (
    is  => 'rw',
    isa => 'Str',
    default => 'Your object has been updated'
);

has 'error_string' => (
    is  => 'rw',
    isa => 'Str',
    default => 'Plese correct the errors below.'
);

has 'rs_key' => (
    is      => 'rw',
    isa     => 'Str',
    default => 'rs'
);

has 'object_key' => (
    is      => 'rw',
    isa     => 'Str',
    default => 'object'
);

has 'class' => (
    is      => 'rw',
    isa     => 'Str'
);

has 'schema_class' => (
    is      => 'rw',
    isa     => 'Str'
);

has 'field_name_maps' => (
    is      => 'rw',
    isa     => 'HashRef|ArrayRef'
);

sub setup : Chained('.') PathPart('') CaptureArgs(0) { 
    my ( $self, $c ) = @_;

    my $rs = $c->model($self->class);

    unless ( $rs and $rs->isa('DBIx::Class::ResultSet') ) {
        die "Invalid configuration, asked for " . 
            $self->class . " but didn't get a resultset back\n";
    }

    if ( $c->session->{checkout} and $c->req->params->{redirect_to} ) {
        $c->stash->{checkout}->{user} = $c->model('Schema::User')
            ->search(
                {
                    'me.user_id' => $c->session->{checkout}->{buyer_id} 
                }, 
                { 
                    prefetch => [ 'profile' ] 
                }
            )->first;
    }

    $c->stash->{ $self->rs_key } = $rs;
}


sub root : Chained('setup') PathPart('') Args(0) ActionClass('REST') {
    my ( $self, $c ) = @_;

    if ( $self->can("setup_search") ) {
        $c->stash->{$self->rs_key} = $self->setup_search({ 
            rs => $c->stash->{ $self->rs_key}, 
            params => $c->req->params 
        });
    }
}

sub search : Chained('setup') PathPart('search') Args(0) ActionClass('REST') { }

sub search_GET {
    my ( $self, $c ) = @_;

    my $data = $c->req->data || $c->req->params;
    my $results = int($data->{results} || 25);
        $results = 25 if int($results) < 1 or int($results) > 25;
    my $page = $data->{page} || 1;
        $page = 1 if int($page) < 1;

    if ( my $index = $data->{startIndex} ) {
        if ( $index > 0 ) {
            $page = int($index / $results) + 1;
            $c->log->debug("$index / $results = $page") if $c->debug;
        }
    }

    my $search = $self->build_search_hash($data);

    $c->stash->{search} = $search;

    my $sort_by = $data->{sort} || $self->order_by;
    my $dir     = uc($data->{dir}) eq 'ASC' ? 'asc' : 'desc';
    # Hacky:
    $sort_by    = "me.$sort_by" if $sort_by and $sort_by !~ /\./;

    my $paged = 1;
    my $extra = {
        prefetch    => $self->prefetch,
        page        => $page, 
        rows        => $results,
        # Since we need quoting, pass a scalar ref into SQL::Abstract
        order_by    => \($sort_by . " " . uc($dir))
    };

    if ( $c->req->params->{download} ) {
        delete $extra->{page};
        delete $extra->{rows};
        $paged = 0;
    }

    if ( $c->debug ) {
        $c->log->info("Search Information:");
        $c->log->_dump({ search => $search, extra => $extra });
    }
    my $rs = $c->stash->{ $self->rs_key }->search( $search, $extra );

    $c->stash->{sort_by} = $sort_by;
    $c->stash->{dir}     = lc($dir);
    $c->stash->{pager}   = $rs->pager if $paged;

    $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
    my $pageSize = $paged ? $c->stash->{pager}->entries_on_this_page : 0;
    my $records = [ $rs->all ];    

    my $sorted_by = $c->stash->{sort_by} || '';
        $sorted_by =~ s/^me\.//;
    $self->status_ok( $c, 
        entity => {
            totalRecords => $paged ?
                int($c->stash->{pager}->total_entries) : scalar(@$records),
            startIndex   => $paged ?
                ( $c->stash->{pager}->entries_per_page * ( $c->stash->{pager}->current_page - 1 ) ) : 1,
            pageSize        => $pageSize,
            sort            => $sorted_by,
            dir             => lc($c->stash->{dir} || 'desc'),
            records         => $records,
        }
    );
}

sub build_search_hash {
    my ( $self, $data ) = @_;

    my $search  = $data->{search};
        $search = {} unless defined $search and ref $search eq 'HASH';

    foreach my $key ( keys %$search ) {
        delete $search->{$key} if $search->{$key} eq '';

        # Flatten prefetches (just works to one level now...)
        if ( ref $search->{$key} eq 'HASH' ) {
            foreach my $prefetch_key ( keys %{ $search->{$key} } ) {
                next unless $search->{$key}->{$prefetch_key};
                $search->{"$key.$prefetch_key"} = $search->{$key}->{$prefetch_key};
            }
            delete $search->{$key};
        }
        if ( $search->{$key} and $search->{$key} =~ /^(>|<)(\d+)$/ ) {
            $search->{$key} = { $1 => $2 };
        }
    }
    if ( $data->{filter} and my $type = $data->{filter}->{type} ) {
        if ( lc($type) eq 'like' ) {
            my @keys = keys %$search;
            if ( $data->{filter}->{keys} ) {
                @keys = ref $data->{filter}->{keys} eq 'ARRAY' ?
                    @{ $data->{filter}->{keys} } : ( $data->{filter}->{keys} );
            }
            foreach my $key ( @keys ) {
                $search->{$key} = { 'LIKE', '%' . $search->{$key} . '%' };
            }
        }
    }

    return $search;
}

sub root_GET { }

sub root_POST {
    my ( $self, $c, $data ) = @_;
    $data ||= $c->req->data || $c->req->params;
    if ( $c->debug ) {
        $c->log->debug("Handling POST to " . $c->req->uri);
        $c->log->_dump($data);
    }
    $c->forward('create', [ $data ]);

    if ( defined ( my $object = $c->stash->{$self->object_key} ) ) {
        $c->forward('post_action');
    }
}

sub object_setup : Chained('setup') PathPart('id') CaptureArgs(1) { 
    my ( $self, $c, $id ) = @_;
    my $obj = $c->stash->{ $self->rs_key }->find( $id );

    unless ( defined $obj ) {
        $c->forward('not_found');
        $self->status_not_found( $c, message => $c->loc("Sorry, unable to find that object") );
        $c->detach;
    }

    $c->stash->{$self->object_key} = $obj;
}

sub object : Chained('object_setup') PathPart('') Args(0) ActionClass('REST') { }

sub object_GET { }

sub object_POST {
    my ( $self, $c, $data ) = @_;
    
    my $obj = $c->stash->{$self->object_key};

    if ( not $data and defined $c->req->data ) {
        $data = expand_hash( $c->req->data );
    } else {
        $data = $c->req->params;
    }

    if ( exists $data->{me} and ref $data->{me} eq 'HASH' ) {
        $c->log->debug("Moving {me} up a level");
        $data = { %$data, %{$data->{me}} }; 
        delete $data->{me};
    }

    if ( $c->debug ) {
        $c->log->debug("Updating object: $obj with:");
        $c->log->_dump( $data );
    }
    if ( $obj ) {
        $c->forward('update', [ $obj, $data ]);
    } else {
        $c->forward('create', [ $data ]);
    }
    $c->forward('post_action');
}

sub object_DELETE {
    my ( $self, $c ) = @_;
    $c->stash->{$self->object_key}->delete;
    return $self->status_ok( $c, entity => { message => 'Deleted' } );
}

sub update : Private {
    my ( $self, $c, $object, $data ) = @_;

    if ( $object->can('update_profile') ) {
        $data = eval { $object->validate( $object->update_profile, $data ); };
        if ( $@ ) {
            if ( ref $@ ) {
                if ( $c->debug ) {
                    $c->log->debug("Validation error on $object:");
                    $c->log->_dump($@);
                }
                $c->message({
                    type => 'error',
                    message => $self->error_string 
                });
                $c->stash->{form} = $@;
                $c->detach;
            }
            die $@;
        }
        delete $data->{'user.verify_password'};
    }
    $object->update( $data );
    $c->message( $self->update_string );
}

sub create : Private {
    my ( $self, $c, $data ) = @_;

    my $object = $c->stash->{$self->rs_key}->new_result( { } );
    $data = eval { $object->validate( $object->update_profile, $data ); };
    if ( $@ ) {
        if ( ref $@ ) {
            $c->stash->{form} = $@;
            $c->detach;
        }
        die $@;
    }
    $object = $c->stash->{$self->rs_key}->create( $data );
    $c->log->debug("Created object: " . $object->id) if $c->debug;
    $c->stash->{$self->object_key} = $object;
    $c->message( $self->create_string );
}

sub post_action : Private {
    my ( $self, $c ) = @_;

    if ( $c->req->looks_like_browser ) {
        my $uri = $c->req->uri;
        if ( $c->req->params->{redirect_to} ) {
            my $new_uri = URI->new($c->req->params->{redirect_to});
            if ( $new_uri->host eq $uri->host ) {
                $uri = $new_uri;
            }
        }

        $c->res->redirect( $uri, 303 );
    } else {
        my $object = $c->stash->{$self->object_key};
        if ( defined $object ) {
            return $self->status_ok( $c, entity => { $object->get_columns } );
        } else {
            return $self->status_ok( $c );
        }
    }
}

sub setup_search {
    my ( $self, $p ) = @_;
    my $rs       = $p->{rs};
    my $params   = $p->{params};
    my $base     = $p->{base} || '';

    my $source ||= $rs->result_source;
    
    my %search_params = 
        map { 
            my $value = $params->{$_};
            if ( $value =~ /LIKE:(.*)?$/ ) {
                $value = { LIKE => $1 };
            }
            elsif ( $value =~ /BETWEEN:(.*);(.*)$/ ) {
                $value = { -between => [ $1, $2 ] };
            }
            ( $base ? join('.', $base, $_) : $_ ) => $value;
        }
        grep { exists $params->{$_} }
        $source->columns;

    my %join_params = ();

    $rs->search({ %search_params }, { %join_params });
}

sub not_found : Private { }

sub end : ActionClass('Serialize') { }

1;