view release on metacpan or  search on metacpan

lib/CatalystX/ListFramework.pm  view on Meta::CPAN

package CatalystX::ListFramework;
use HTML::Widget;
use File::Slurp;
use Data::Dumper;
use Carp;

use strict;
use warnings;
our $VERSION = '0.5';
require 5.8.1;

=head1 NAME

CatalystX::ListFramework - foundations for displaying and editing lists (CRUD) in a Catalyst application

=head1 SYNOPSIS

    package MyApp::Controller::Foo;
    use base 'Catalyst::Controller';
    use CatalystX::ListFramework;
    
    sub listandsearch :Local {
        my ($self, $c, $kind) = @_;
        my $lf = CatalystX::ListFramework->new($kind, $c);
        my $restrict = {};
        $lf->stash_listing('myview', 'myprefix', $restrict);
        $c->stash->{template} = 'list-and-search.tt';
    }

    sub get :Local {
        my ($self, $c, $kind, $id) = @_;
        my $lf = CatalystX::ListFramework->new($kind, $c);
        $lf->stash_infoboxes({'me.id' => $id}); 
        $c->stash->{kind} = $kind;
        $c->stash->{id} = $id;  # the update form adds this to the URL
        $c->stash->{template} = 'detail.tt';
    }
    
    sub update :Local {
        my ($self, $c, $kind, $id) = @_;
        my $lf = CatalystX::ListFramework->new($kind, $c);
        $lf->update_from_query({'me.id' => $id}); 
        $c->res->redirect("/listandsearch/$kind");
    }
    
    sub create :Local {
        my ($self, $c, $kind) = @_;
        my $lf = CatalystX::ListFramework->new($kind, $c);
        my $id = $lf->create_new; 
        $c->res->redirect("/get/$kind/$id");
    }

=head1 DESCRIPTION

Displaying tabulated lists of database records, updating those records and
creating new ones is a common task in Catalyst applications.
This class supplies such lists, and forms to edit such records, to a set of
templates, using simple definition files and your L<DBIx::Class> Catalyst
model. A search form is also supplied, which can include JSON-powered
ExtJS comboboxes (see L<http://www.extjs.com/>).

To run the included demo application, grab a copy of ExtJS, then

    cd t/
    ln -s /path/to/extjs/ static/extjs-1.1
    lib/script/testapp_server.pl

then

    firefox http://localhost:3000/start
    
Please see L<BUGS> about some SQLite issues with the demo app.
The noninteractive test suite is

    perl live-test.pl
    

=head1 DEFINITION FILES

ListFramework is driven by a set of definition files, found under C<formdef/>, one pair per schema class (table).
These are divided into 'master' files and 'site' files and are named I<kind>.form.
Files under C<master/> describe a I<kind>'s source, what fields it has available, and how it is
associated with other schema classes.
Files under C<site/> describe how the data is displayed on the page.
This division, and the naming, implies that a vendor (you) could supply the master files, while a particular
installation could use customised site files to suit their needs.

These are best understood by looking at the example files.

=head2 Files under /master

The sections in these files are:

=over

=item title

A title, displayed on various screens.

lib/CatalystX/ListFramework.pm  view on Meta::CPAN

    
    foreach my $box (keys %{$self->{formdef}->{infoboxes}}) {
        my @info;
        my $columns = $self->{formdef}->{infoboxes}->{$box};

        # Copy metadata (headings etc) from 'columns' (maybe in a related form file)
        $self->copy_metadata_from_columns($columns);

        # Make calls on the row object to fill the various columns
        my $processed_row = $self->rowobject_to_columns($db_row, $columns); # a hashref with col_id => celldata

        foreach my $col (@$columns) {
            my %object_info;
            if (ref($processed_row->{$col->{id}})) {  # if it's a '.OBJECT' entry, i.e. to select a belongs_to thing
                %object_info = (
                                primary_key  => $col->{primary_key},  # master formdef columns line for OBJECT sets this
                                form_type    => $col->{form_type},  # some duplication here. This is set by new()
                                stringified  => "$processed_row->{$col->{id}}", # use overloaded ""
                                is_object    => 1,
                               );
            }
            my $is_editable = 1;
            # anything that's not a simple single field or that has a not_editable key isn't editable
            $is_editable = 0 if ($col->{field} && (ref($col->{field}) || $col->{not_editable} || $col->{field} !~ m{^\w+$}));
            
            push @info, {
                          name       => $col->{heading},
                          id         => $col->{id},
                          value      => $processed_row->{$col->{id}},
                          options    => $col->{options},
                          type       => $col->{type},
                          is_editable=> $is_editable,
                          %object_info,
                        };
        }

        # If no column ids were specified for this box, just stash the DB object and let the template do what it likes.
        if (scalar(@info)) {
            $box_data->{$box} = \@info;
        }
        else {
            $box_data->{$box} = $db_row;
        }
        my $title = ucfirst($box);
        $title =~ tr/_/ /;
        push @$box_metadata, {id=>$box, title=>$title};
    }
    
    if (ref($self->{formdef}->{infobox_order})) {
        @$box_metadata = sort { $self->{formdef}->{infobox_order}->{$a->{id}}
                                  <=>
                                $self->{formdef}->{infobox_order}->{$b->{id}}
                              } @$box_metadata;
    }
    $c->stash->{box_metadata} = $box_metadata;
    $c->stash->{box_data} = $box_data;

    return 1;
}

sub update_from_query {  # Update a record. Probably called from an infobox screen
    my ($self, $search) = @_;
    my $c = $self->{c};
    my $rs = $c->model($self->{formdef}->{model})->search($search, {});  # NB: no joins. We'll assume we're looking locally for an id
    my $db_row_obj = $rs->first;
    unless (ref $db_row_obj) { confess "No such object found"; }
    
    # All editable fields must be listed in the infobox section
    my $all_cols;
    foreach my $box (keys %{$self->{formdef}->{infoboxes}}) {
        my $columns = $self->{formdef}->{infoboxes}->{$box};
        push @$all_cols, @$columns;
    }
    $self->copy_metadata_from_columns($all_cols);

    foreach my $col (@$all_cols) {
        next if ($col->{field} && (ref($col->{field}) || $col->{not_editable} || $col->{field} !~ m{^\w+$}));
        if (my $new_value = $c->req->params->{$col->{id}}) {
            my $row_in_wanted_table = $db_row_obj;
            my $row_in_parent_table = undef; # this is the one we must update if we're being sent an OBJECT id
            {
                # Obtain the row object on which to call update.
                my $col_id = $col->{id};
                while ($col_id =~ m{^(\w+)\.(.+)}) { # work along the abc.def.ghi relationships til we get to the final row obj we want
                    $row_in_parent_table = $row_in_wanted_table;
                    $row_in_wanted_table = eval("\$row_in_parent_table->$1");
                    if ($@) { die "Eval of row->$1 failed"; }
                    $col_id = $2;
                }
            }
            if ($col->{id} =~ m{\.OBJECT$}) { # called from stash_infoboxes and requesting the relationship be updated by id
                my $foreign_model = $col->{model}; # filled-in by new() above
                $col->{id} =~ m{(\w+)\.OBJECT$};
                my $rel = $1;
                #warn "Fetching id $new_value from $foreign_model to update $rel";
                (my $new_foreign_row) = $c->model($foreign_model)->find($new_value);
                die "Row for new relationship setting not found" if (!ref $new_foreign_row);
                $row_in_parent_table->update_from_related($rel, $new_foreign_row);
            }
            else {
                if (defined $col->{type}) {
                    eval "\$new_value = \&CatalystX::ListFramework::Helpers::Types::inverse$col->{type}(\"$new_value\", \$c, \$self->{formdef})";
                    if ($@) {die "Type-helper call failed: $@";}
                }
                # Do the update
                eval("\$row_in_wanted_table->$col->{field}(\$new_value); \$row_in_wanted_table->update;");
                if ($@) { die "Error while updating row: $@"; }
            }
        }
    }
}

sub create_new {
    my ($self, $columnvalues, $dont_set_rels) = @_;
    my $c = $self->{c};
    my $columns = $self->{formdef}->{columns};
    my $relationships = $self->{formdef}->{uses};
    
    # Do the create(). Use default_value if specified in a column hash, and set 'belongs_to's to the 1st row out of the hat.
    my $create_hash = $columnvalues;
    foreach my $col (keys %$columns) {