lib/Maypole/Model/CDBI.pm

   1 package Apache::MVC::Model::CDBI;
   2 use base qw(Apache::MVC::Model::Base Class::DBI);
   3 use Lingua::EN::Inflect::Number qw(to_PL);
   4 use Class::DBI::AsForm;
   5 use Class::DBI::FromCGI;
   6 use Class::DBI::AbstractSearch;
   7 use Class::DBI::Plugin::RetrieveAll;
   8 use Class::DBI::Pager;
   9 use CGI::Untaint;
  10 use strict;
  11
  12 =head1 NAME
  13
  14 Apache::MVC::Model::CDBI - Model class based on Class::DBI
  15
  16 =head1 DESCRIPTION
  17
  18 This is a master model class which uses C<Class::DBI> to do all the hard
  19 work of fetching rows and representing them as objects. It is a good
  20 model to copy if you're replacing it with other database abstraction
  21 modules.
  22
  23 =cut
  24
  25 sub related {
  26     my ($self, $r) = @_;
  27     # Has-many methods; XXX this is a hack
  28     map {to_PL($_)}
  29     grep { exists $r->{config}{ok_tables}{$_} }
  30     map {$_->table}
  31     keys %{shift->__hasa_list || {}}
  32 }
  33
  34 sub do_edit :Exported {
  35     my ($self, $r) = @_;
  36     my $h = CGI::Untaint->new(%{$r->{params}});
  37     my ($obj) = @{$r->objects};
  38     if ($obj) {
  39         # We have something to edit
  40         $obj->update_from_cgi($h);
  41         warn "Updating an object ($obj) with ".Dumper($h); use Data::Dumper;
  42     } else {
  43         $obj = $self->create_from_cgi($h);
  44     }
  45     if (my %errors = $obj->cgi_update_errors) {
  46         # Set it up as it was:
  47         warn "There were errors: ".Dumper(\%errors)."\n";
  48         $r->{template_args}{cgi_params} = $r->{params};
  49         $r->{template_args}{errors} = \%errors;
  50         $r->{template} = "edit";
  51     } else {
  52         $r->{template} = "view";
  53     }
  54     $r->objects([ $obj ]);
  55 }
  56
  57 sub delete :Exported {
  58     my ($self, $r) = @_;
  59     $_->SUPER::delete for @{ $r->objects };
  60     $r->objects([ $self->retrieve_all ]);
  61     $r->{template} = "list";
  62 }
  63
  64 sub adopt {
  65     my ($self, $child) = @_;
  66     $child->autoupdate(1);
  67     $child->columns( Stringify => qw/ name / );
  68 }
  69
  70 sub search :Exported {
  71     return shift->SUPER::search(@_) if caller eq "Class::DBI"; # oops
  72     my ($self, $r) = @_;
  73     my %fields = map {$_ => 1 } $self->columns;
  74     my $oper = "like"; # For now
  75     use Carp; Carp::confess("Urgh") unless ref $r;
  76     my %params = %{$r->{params}};
  77     my %values = map { $_ => {$oper, $params{$_} } }
  78                  grep { $params{$_} and $fields{$_} } keys %params;
  79
  80     $r->objects([ %values ? $self->search_where(%values) : $self->retrieve_all ]);
  81     $r->template("list");
  82     $r->{template_args}{search} = 1;
  83 }
  84
  85 sub list :Exported {
  86     my ($self, $r) = @_;
  87     my %ok_columns = map {$_ => 1} $self->columns;
  88     if ( my $rows = $r->config->{rows_per_page}) {
  89         $self = $self->pager($rows, $r->query->{page});
  90         $r->{template_args}{pager} = $self;
  91     }
  92     my $order;
  93     if ($order = $r->query->{order} and $ok_columns{$order}) {
  94         $r->objects([ $self->retrieve_all_sorted_by( $order.
  95             ($r->query->{o2} eq "desc" && " DESC")
  96         )]);
  97     } else {
  98         $r->objects([ $self->retrieve_all ]);
  99     }
 100 }
 101 1;
 102