From 21e0e0c44d23d0d1f0612e4d009c83d010bfb50c Mon Sep 17 00:00:00 2001 From: Simon Cozens Date: Thu, 29 Jan 2004 16:57:39 +0000 Subject: [PATCH] General restructuring, and a delete method which doesn't quite work yet. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@17 48953598-375a-da11-a14b-00016c27c3ee --- lib/Apache/MVC.pm | 9 +++++++-- lib/Apache/MVC/Model/Base.pm | 17 ++++++----------- lib/Apache/MVC/Model/CDBI.pm | 14 +++++++++++++- lib/Apache/MVC/View/TT.pm | 1 + 4 files changed, 27 insertions(+), 14 deletions(-) diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 25a8adb..8ed51bf 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -50,7 +50,7 @@ sub init { $config->{display_tables} ||= [ $class->config->{loader}->tables ]; for my $subclass (@{$config->{classes}}) { no strict 'refs'; - push @{$subclass."::ISA"}, $class->config->{model}; + unshift @{$subclass."::ISA"}, $class->config->{model}; $config->{model}->adopt($subclass) if $config->{model}->can("adopt"); } @@ -106,16 +106,21 @@ sub is_applicable { my $self = shift; my $config = $self->config; my %ok = map {$_ => 1} @{$config->{display_tables}}; + warn "We don't have that table ($self->{table})" + unless $ok{$self->{table}}; return DECLINED() unless exists $ok{$self->{table}}; # Does the action method exist? + # XXX We should set the method class to the class for the table my $cv = $self->model_class->can($self->{action}); + warn "We don't have that action ($self->{action})" unless $cv; return DECLINED() unless $cv; # Is it exported? $self->{method_attribs} = join " ", attributes::get($cv); + do { warn "$self->{action} not exported"; return DECLINED() - unless $self->{method_attribs} =~ /\bExported\b/i; + } unless $self->{method_attribs} =~ /\bExported\b/i; return OK(); } diff --git a/lib/Apache/MVC/Model/Base.pm b/lib/Apache/MVC/Model/Base.pm index 89feb7c..afbc60d 100644 --- a/lib/Apache/MVC/Model/Base.pm +++ b/lib/Apache/MVC/Model/Base.pm @@ -7,25 +7,20 @@ sub MODIFY_CODE_ATTRIBUTES { sub FETCH_CODE_ATTRIBUTES { $remember{$_[1]} } -sub view :Exported { - my ($self, $r) = @_; - return $self->retrieve(shift @{$r->{args}}); -} - -sub edit :Exported { - my ($self, $r) = @_; - return $self->retrieve(shift @{$r->{args}}); -} +sub view :Exported { } +sub edit :Exported { } sub do_edit { die "This is an abstract method" } +sub get_objects { die "This is an abstract method" } sub list :Exported { my ($self, $r) = @_; - return $self->retrieve_all; + $r->objects([ $self->retrieve_all ]); } sub process { my ($class, $r) = @_; $r->template( my $method = $r->action ); - $r->objects([ $class->$method($r) ]); + $r->objects([ $class->get_objects($r) ]); + $class->$method($r) } diff --git a/lib/Apache/MVC/Model/CDBI.pm b/lib/Apache/MVC/Model/CDBI.pm index f9918bc..833550d 100644 --- a/lib/Apache/MVC/Model/CDBI.pm +++ b/lib/Apache/MVC/Model/CDBI.pm @@ -8,13 +8,18 @@ sub description { "A poorly defined class" } sub column_names { my $class = shift; map { $_ => ucfirst $_ } $class->columns } +sub get_objects { + my ($self, $r) = @_; + return $self->retrieve(shift @{$r->{args}}); +} + sub do_edit :Exported { my ($self, $r) = @_; my $h = CGI::Untaint->new(%{$r->{params}}); my $obj; if (@{$r->{args}}) { # We have something to edit - $obj = $self->retrieve($r->{args}[0]); + ($obj) = @{$self->objects}; $obj->update_from_cgi($h); warn "Updating an object ($obj) with ".Dumper($h); use Data::Dumper; } else { @@ -32,6 +37,13 @@ sub do_edit :Exported { return $obj; } +sub delete :Exported { + my ($self, $r) = @_; + $self->delete for @{ $r->objects }; + $r->objects([ $self->retrieve_all ]); + $r->{template} = "list"; +} + sub adopt { my ($self, $child) = @_; $child->autoupdate(1); diff --git a/lib/Apache/MVC/View/TT.pm b/lib/Apache/MVC/View/TT.pm index e2a1504..90624ad 100644 --- a/lib/Apache/MVC/View/TT.pm +++ b/lib/Apache/MVC/View/TT.pm @@ -27,6 +27,7 @@ sub _args { class => $class, objects => $r->objects, base => $r->config->{uri_base}, + config => $r->config # ... ); $args{classmetadata} = { -- 2.39.5