lib/Apache/MVC.pm

   1 package Apache::MVC;
   2 use base qw(Class::Accessor Class::Data::Inheritable);
   3 use attributes ();
   4 use Class::DBI::Loader;
   5 use strict;
   6 use warnings;
   7 our $VERSION = "1.0";
   8
   9 __PACKAGE__->mk_classdata($_) for qw( _config init_done view_object );
  10 __PACKAGE__->mk_accessors ( qw( config ar params objects model_class args ));
  11 __PACKAGE__->config({});
  12 __PACKAGE__->init_done(0);
  13
  14 # This is really dirty.
  15 sub config {
  16     my $self = shift;
  17     if (ref $self) { return $self->_config_accessor(@_) }
  18     return $self->_config(@_);
  19 }
  20
  21 sub set_database {
  22     my ($calling_class, $dsn) = @_;
  23     $calling_class = ref $calling_class if ref $calling_class;
  24     $calling_class->config->{dsn} = $dsn;
  25     $calling_class->config->{loader} = Class::DBI::Loader->new(
  26         namespace => $calling_class,
  27         dsn => $dsn
  28     );
  29 }
  30
  31 sub init {
  32     my $class = shift;
  33     my $config = $class->config;
  34     $config->{model} ||= "Apache::MVC::Model::CDBI";
  35     $config->{view}  ||= "Apache::MVC::View::TT";
  36     $config->{classes} = [ $class->config->{loader}->classes ];
  37     $config->{display_tables} ||= [ $class->config->{loader}->tables ];
  38     for my $class (@{$config->{classes}}) {
  39         no strict 'refs';
  40         push @{$class."::ISA"}, $class->config->{model};
  41     }
  42     $class->view_object($class->config->{view}->new);
  43
  44 }
  45
  46 sub class_of {
  47     my ($self, $table) = @_;
  48     return $self->config->{loader}->_table2class($table);
  49 }
  50
  51 sub handler {
  52     # See Apache::MVC::Workflow before trying to understand this.
  53     my $class = (caller(0))[0];
  54     $class->init unless $class->init_done;
  55     my $r = bless { config => $class->config }, $class;
  56     $r->get_request();
  57     $r->parse_location();
  58     $r->model_class($r->class_of($r->{table}));
  59     my $status = $r->is_applicable;
  60     return $status unless $status == 200;
  61     $status = $r->call_authenticate;
  62     return $status unless $status == 200;
  63     $r->find_objects();
  64     $r->additional_data();
  65     $r->class->process($r);
  66 }
  67
  68 sub get_request {
  69     my $self = shift;
  70     require Apache; require Apache::Request;
  71     $self->{ar} = Apache::Request->new(Apache->request);
  72 }
  73
  74 sub parse_location {
  75     my $self = shift;
  76     my @pi = split /\//, $self->{ar}->uri();
  77     shift @pi while @pi and !$pi[0];
  78     $self->{table} = shift @pi;
  79     $self->{action} = shift @pi;
  80     $self->{args} = \@pi;
  81 }
  82
  83 sub is_applicable {
  84     my $self = shift;
  85     require Apache::Constants;
  86     Apache::Constants->import(":common");
  87     my $config = $self->config;
  88     my %ok = map {$_ => 1} @{$config->{displaying_tables}};
  89     return DECLINED() unless exists $ok{$self->{table}};
  90
  91     # Does the action method exist?
  92     my $cv = $self->model_class->can($self->{action});
  93     return DECLINED() unless $cv;
  94
  95     # Is it exported?
  96     $self->{method_attribs} = join " ", attributes::get($cv);
  97     return DECLINED()
  98      unless $self->{method_attribs} =~ /\b(Exported|Class|Single|Multiple)\b/i;
  99     return OK();
 100 }
 101
 102 sub find_objects {
 103     # First, how many arguments are we?
 104 }
 105
 106 sub authenticate { return 200 }
 107
 108 1;