From: Simon Cozens Date: Wed, 11 Feb 2004 15:04:09 +0000 (+0000) Subject: Make this a proper subclass. X-Git-Tag: 2.10~304 X-Git-Url: https://git.decadent.org.uk/gitweb/?a=commitdiff_plain;h=b4c877459674a8da7943533c780f807f3a355906;p=maypole.git Make this a proper subclass. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@58 48953598-375a-da11-a14b-00016c27c3ee --- diff --git a/lib/Apache/MVC.pm b/lib/Apache/MVC.pm index 960888f..5d999be 100644 --- a/lib/Apache/MVC.pm +++ b/lib/Apache/MVC.pm @@ -1,92 +1,13 @@ package Apache::MVC; -use base qw(Class::Accessor Class::Data::Inheritable); -use attributes (); -use Class::DBI::Loader; -use UNIVERSAL::require; -use Apache::Constants ":common"; +use base 'Maypole'; +use Apache; +use Apache::Request; use strict; use warnings; -our $VERSION = "0.2"; -__PACKAGE__->mk_classdata($_) for qw( config init_done view_object ); -__PACKAGE__->mk_accessors ( qw( ar params query objects model_class -args action template )); -__PACKAGE__->config({}); -__PACKAGE__->init_done(0); - - -sub import { - my $real = shift; - if ($real ne "Apache::MVC") { - no strict 'refs'; - *{$real."::handler"} = sub { Apache::MVC::handler($real, @_) }; - } -} - -sub set_database { - my ($calling_class, $dsn) = @_; - $calling_class = ref $calling_class if ref $calling_class; - my $config = $calling_class->config; - $config->{model} ||= "Apache::MVC::Model::CDBI"; - $config->{model}->require; - $config->{dsn} = $dsn; - $config->{loader} = Class::DBI::Loader->new( - namespace => $calling_class, - dsn => $dsn - ); - $config->{classes} = [ $config->{loader}->classes ]; - for my $subclass (@{$config->{classes}}) { - no strict 'refs'; - unshift @{$subclass."::ISA"}, $config->{model}; - $config->{model}->adopt($subclass) - if $config->{model}->can("adopt"); - } -} - -sub init { - my $class = shift; - my $config = $class->config; - $config->{view} ||= "Apache::MVC::View::TT"; - $config->{view}->require; - $config->{display_tables} ||= [ $class->config->{loader}->tables ]; - $class->view_object($class->config->{view}->new); - $class->init_done(1); - -} - -sub class_of { - my ($self, $table) = @_; - return $self->config->{loader}->_table2class($table); -} - -sub handler { - # See Apache::MVC::Workflow before trying to understand this. - my $class = shift; - $class->init unless $class->init_done; - my $r = bless { config => $class->config }, $class; - $r->get_request(); - $r->parse_location(); - - $r->model_class($r->class_of($r->{table})); - my $status = $r->is_applicable; - if ($status == OK) { - $status = $r->call_authenticate; - return $status unless $status == OK; - $r->additional_data(); - - $r->model_class->process($r); - } else { - # Otherwise, it's just a plain template. - delete $r->{model_class}; - $r->{path} =~ s{/}{}; # De-absolutify - $r->template($r->{path}); - } - return $r->view_object->process($r); -} +our $VERSION = "0.3"; sub get_request { - my $self = shift; - require Apache; require Apache::Request; - $self->{ar} = Apache::Request->new(Apache->request); + shift->{ar} = Apache::Request->new(Apache->request); } sub parse_location { @@ -105,38 +26,6 @@ sub parse_location { $self->{query} = { $self->{ar}->args }; } -sub is_applicable { - my $self = shift; - my $config = $self->config; - $config->{ok_tables} = {map {$_ => 1} @{$config->{display_tables}}}; - warn "We don't have that table ($self->{table})" - unless $config->{ok_tables}{$self->{table}}; - return DECLINED() unless exists $config->{ok_tables}{$self->{table}}; - - # Does the action method exist? - 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; - return OK(); -} - -sub call_authenticate { - my $self = shift; - return $self->model_class->authenticate($self) if - $self->model_class->can("authenticate"); - return $self->authenticate(); -} - -sub additional_data {} - -sub authenticate { return OK } - 1; =head1 NAME