2 use base qw(Class::Accessor Class::Data::Inheritable);
4 use Class::DBI::Loader;
5 use UNIVERSAL::require;
6 use Apache::Constants ":common";
10 __PACKAGE__->mk_classdata($_) for qw( _config init_done view_object );
11 __PACKAGE__->mk_accessors ( qw( config ar params objects model_class
12 args action template ));
13 __PACKAGE__->config({});
14 __PACKAGE__->init_done(0);
19 if ($real ne "Apache::MVC") {
21 *{$real."::handler"} = sub { Apache::MVC::handler($real, @_) };
25 # This is really dirty.
28 if (ref $self) { return $self->_config_accessor(@_) }
29 return $self->_config(@_);
33 my ($calling_class, $dsn) = @_;
34 $calling_class = ref $calling_class if ref $calling_class;
35 $calling_class->config->{dsn} = $dsn;
36 $calling_class->config->{loader} = Class::DBI::Loader->new(
37 namespace => $calling_class,
44 my $config = $class->config;
45 $config->{model} ||= "Apache::MVC::Model::CDBI";
46 $config->{view} ||= "Apache::MVC::View::TT";
47 $config->{model}->require;
48 $config->{view}->require;
49 $config->{classes} = [ $class->config->{loader}->classes ];
50 $config->{display_tables} ||= [ $class->config->{loader}->tables ];
51 for my $subclass (@{$config->{classes}}) {
53 unshift @{$subclass."::ISA"}, $class->config->{model};
54 $config->{model}->adopt($subclass)
55 if $config->{model}->can("adopt");
57 $class->view_object($class->config->{view}->new);
63 my ($self, $table) = @_;
64 return $self->config->{loader}->_table2class($table);
68 # See Apache::MVC::Workflow before trying to understand this.
70 $class->init unless $class->init_done;
71 my $r = bless { config => $class->config }, $class;
75 $r->model_class($r->class_of($r->{table}));
76 my $status = $r->is_applicable;
77 return $status unless $status == OK;
78 $status = $r->call_authenticate;
79 return $status unless $status == OK;
80 $r->additional_data();
82 $r->model_class->process($r);
83 $r->view_object->process($r);
84 return $r; # For debugging.
89 require Apache; require Apache::Request;
90 $self->{ar} = Apache::Request->new(Apache->request);
95 my $uri = $self->{ar}->path_info();
96 my @pi = split /\//, $uri;
97 shift @pi while @pi and !$pi[0];
98 $self->{table} = shift @pi;
99 $self->{action} = shift @pi;
100 $self->{args} = \@pi;
102 $self->{params} = { $self->{ar}->content };
107 my $config = $self->config;
108 my %ok = map {$_ => 1} @{$config->{display_tables}};
109 warn "We don't have that table ($self->{table})"
110 unless $ok{$self->{table}};
111 return DECLINED() unless exists $ok{$self->{table}};
113 # Does the action method exist?
114 # XXX We should set the method class to the class for the table
115 my $cv = $self->model_class->can($self->{action});
116 warn "We don't have that action ($self->{action})" unless $cv;
117 return DECLINED() unless $cv;
120 $self->{method_attribs} = join " ", attributes::get($cv);
121 do { warn "$self->{action} not exported";
123 } unless $self->{method_attribs} =~ /\bExported\b/i;
127 sub call_authenticate {
129 return $self->model_class->authenticate($self) if
130 $self->model_class->can("authenticate");
131 return $self->authenticate();
134 sub additional_data {}
136 sub authenticate { return OK }