DoesCRUD.pm

package SuiteSetup::Web::DoesCRUD;

use MooseX::MethodAttributes::Role;
use namespace::autoclean;
use Data::Dumper;
use Carp qw(croak);
use Hash::Merge qw( merge );
use Try::Tiny;

=head2 rs

Name of the ResultSet class that will be used for CRUD.

=cut

has 'rs' => (
  is  => 'rw',
  required => 1,
  lazy => 1,
  default => sub { 
    croak "rs attribute required"
  },
);

=head2 create_method

Name of the method used for creating methods.  Useful since we have a custom "create_person" method

=cut

has 'create_method' => (
  is => 'rw',
  required => 1,
  lazy => 1,
  default => "create"
);

=head2 update_method

Update attribute to specify a custom update method.

=cut

has 'update_method' => (
  is => 'rw',
  required => 1,
  lazy => 1,
  default => "update"
);

=head2 create_columns

Arrayref of columns that are to be affected by C<< create >>

=cut

has 'create_columns' => (
  is => 'rw',
  isa => 'ArrayRef',
  lazy => 1,
  default => sub {
    croak "You must specify columns affected by create",
  },
);

=head2 select_columns

Columns to grab from the table 

=cut

# TODO: default to ->columns
has 'select_columns' => (
  is => 'rw',
  isa => 'ArrayRef',
  lazy => 1,
  default => sub {
    croak "You must specify columns to select",
  },
);

=head2 stash_key

Stash key to merge in case you want to add more data to create/update methods in your pre/post hooks

=cut

has 'stash_key' => (
  is => 'rw',
  lazy => 1,
  default => "crud_data",
);

## next bit of code stolen from C::C::DBIC::API

=head2 base

Set up the very base of our config

=cut

sub base : Chained('specify.in.config') PathPart('specify.in.config') CaptureArgs(0) {}

=head2 object_without_id

Chain base for such urls as:
  
  * /item/new
  * /items

Also provide options to send to the resultset object's C<< ->search >> method for sorting, constraining, grouping, etc.

=cut

## /user/new
## /users
sub object_without_id :Chained('base') PathPart('') CaptureArgs(0) {
  my ( $self, $c ) = @_;
  my $rs = $c->model($self->rs);
  my $params = $c->req->params;
  # this search stuff currently isn't being used
  my $query = $params->{'columns'}                            ? 
    map {{ $_ => $params->{'q'} }} @{ $params->{'columns'} }  :
    {};
  my $order_dir = $params->{'direction'} || "-desc";
  my $search_options = {
    order_by => { 
      $order_dir  => $params->{'col'}
    }, 
    group_by => $params->{'grouping'} || "",
  };
  ##
  $c->stash( rs => $rs );
}

=head2 object_with_id

Chain base for such urls as: 

  * /item/:id
  * /item/:id/action

=cut

## /user/1
## /user/1/update
sub object_with_id :Chained('base') PathPart('') CaptureArgs(1) {
  my ($self, $c, $objectid) = @_;
  my $rs = $c->model($self->rs);
  my $object = $rs->find($objectid);
  $c->stash( object => $object );
}

=head2 create

Endpoint for creating a record.  Uses the C<< $self->rs >> and C<< $self->create_method >> attributes
to create the record.

=cut

sub create : Chained('object_without_id') PathPart('new') Args(0) Method('POST'){
  my ( $self, $c ) = @_;
  my $rs = $c->stash->{'rs'};
  my $params = merge( $c->stash->{$self->stash_key}, $c->req->params ); 
  my %columns =  map { $_ => $params->{$_} } @{ $self->create_columns };
  my $create_method = $self->create_method;
  my $object = $rs->$create_method( \%columns );
  $c->stash( object => $object );
  $c->log->debug("OBJECT CREATE " . Dumper $object);
}

=head2 read

Endpoint for reading a record. Returns whatever is retrieved in the C<< object_with_id >> midpoint.

=cut

sub read :Chained('object_with_id') 
          PathPart('') 
          Args(0)
          Method('GET') {
  my ( $self, $c ) = @_;
  my $object = $c->stash->{'object'};
  $c->log->debug("OBJECT READ " . Dumper $object);
  $c->stash( 
    object => {
      map {
        $_ => $object->$_ 
      } @{ $self->select_columns } 
    }
  );
}

=head2 list

Endpoint to list a given number of records in a resultset.

=cut

sub list :Chained('object_without_id') 
          PathPart('') 
          Args(0) 
          Method('GET') {
  my ( $self, $c ) = @_;
  my $rs = $c->stash->{'rs'};
  my $object_rs = $rs->search({}, {
    select => $self->select_columns,
  });  
  $c->stash(
    objects => $object_rs
  );
}

=head2 update

Endpoint for updating a record.  Grabs the object stored in the C<< object_with_id >> midpoint,
and updates it with the new parameters.  Returns newly updated object to the view.

=cut

sub update :Chained('object_with_id') 
            PathPart('edit') 
            Args(0)
            Method('POST')
            Method('PUT') {
  my ( $self, $c ) = @_;
  my $object = $c->stash->{'object'}; 
  my $params = $c->req->params;
  my $update_method = $self->update_method;
  try {
    my $updated = $object->$update_method($params);
    $c->stash( object => $updated );
  } catch {
    $c->message({
      type => "error",
      message => "error updating $_"
    });
    $c->detach();
  };
}

=head2 delete

Endpoint for deleting an object.  Grabs the object stored in the C<< object_with_id >> midpoint,
and deletes it.  Returns ID of the record deleted.

=cut


## TODO: automatic required "Confirm delete" screen here?
sub delete :Chained('object_with_id') 
            PathPart('delete') 
            Args(0)
            Method('DELETE')
            Method('GET')
            Method('POST') {
  my ( $self, $c ) = @_;
  my $object = $c->stash->{'object'}; 
  my $params = $c->req->params;
  try {
    $object->delete || die $!;
  } catch {
    $c->message({
      type => "error",
      message => "error deleting $_"
    });
    $c->detach();
  };
  $c->stash( object => $object );
}

#__PACKAGE__->meta->make_immutable; 
1;

PrePostHooking.pm

package SuiteSetup::Web::ActionRole::PrePostHooking;

use Moose::Role;
use Data::Dumper;

=head2 pre_hook|post_hook

Name of the method to be called for (pre|post)-hooks on actions

=cut

has [qw( pre_hook post_hook )]  => (
  is => 'rw',
  lazy => 1,
  default => sub {}
); 


#pre hooks
before execute => sub { 
  my @params = @_; 
  push @params, 'pre'; 
  _handle_hook(@params) 
};

#post hooks
after execute => sub { 
  my @params = @_; 
  push @params, 'post'; 
  _handle_hook(@params) 
};

# generic hook handling sub
sub _handle_hook {
  my ( $self, $controller, $c, $prefix) = @_;
  my $action_name = (split(/\//, $c->action))[-1];
  my $hook_name = "_" . $prefix . "_" . $action_name;
  if ( $controller->can($hook_name) && ($action_name eq $self->name ) ) {
    $c->log->debug( $self->name . " CAN $hook_name");
    $controller->$hook_name($c);
  } else {
    $c->log->debug( $self->name . " CAN'T $hook_name");
  }
}

1;