lib/Apache/MVC/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 CGI::Untaint;
   7 use strict;
   8
   9 sub description { "A poorly defined class" }
  10
  11 sub column_names { my $class = shift; map { $_ => ucfirst $_ } $class->columns }
  12
  13 sub get_objects {
  14     my ($self, $r) = @_;
  15     return $self->retrieve(shift @{$r->{args}});
  16 }
  17
  18 sub related {
  19     my ($self, $r) = @_;
  20     # Has-many methods; XXX this is a hack
  21     map {to_PL($_)}
  22     grep { exists $r->{config}{ok_tables}{$_} }
  23     map {$_->table}
  24     keys %{shift->__hasa_list || {}}
  25 }
  26
  27 sub do_edit :Exported {
  28     my ($self, $r) = @_;
  29     my $h = CGI::Untaint->new(%{$r->{params}});
  30     my ($obj) = @{$r->objects};
  31     if ($obj) {
  32         # We have something to edit
  33         $obj->update_from_cgi($h);
  34         warn "Updating an object ($obj) with ".Dumper($h); use Data::Dumper;
  35     } else {
  36         $obj = $self->create_from_cgi($h);
  37     }
  38     if (my %errors = $obj->cgi_update_errors) {
  39         # Set it up as it was:
  40         warn "There were errors: ".Dumper(\%errors)."\n";
  41         $r->{template_args}{cgi_params} = $r->{params};
  42         $r->{template_args}{errors} = \%errors;
  43         $r->{template} = "edit";
  44     } else {
  45         $r->{template} = "view";
  46     }
  47     $r->objects([ $obj ]);
  48 }
  49
  50 sub delete :Exported {
  51     my ($self, $r) = @_;
  52     $_->SUPER::delete for @{ $r->objects };
  53     $r->objects([ $self->retrieve_all ]);
  54     $r->{template} = "list";
  55 }
  56
  57 sub adopt {
  58     my ($self, $child) = @_;
  59     $child->autoupdate(1);
  60     $child->columns( Stringify => qw/ name / );
  61 }
  62
  63 sub search :Exported {
  64     my ($self, $r) = @_;
  65     my %fields = map {$_ => 1 } $self->columns;
  66     my %values = map { $_ => $params{$_} }
  67                  grep { $params{$_} and $fields{$_} } keys %{$r->{params}};
  68     $r->objects([ %values ? $self->search_like(%values) : $self->retrieve_all ]);
  69     $r->template("list");
  70     $r->{template_args}{search} = 1;
  71 }
  72
  73
  74 1;