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 strict;
use warnings;
our $VERSION = "1.0";
__PACKAGE__->mk_classdata($_) for qw( _config init_done view_object );
__PACKAGE__->mk_accessors ( qw( config ar params 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, @_) };
    }
}

# This is really dirty.
sub config {
    my $self = shift;
    if (ref $self) { return $self->_config_accessor(@_) }
    return $self->_config(@_);
}

sub set_database {
    my ($calling_class, $dsn) = @_;
    $calling_class = ref $calling_class if ref $calling_class;
    $calling_class->config->{dsn} = $dsn;
    $calling_class->config->{loader} = Class::DBI::Loader->new(
        namespace => $calling_class,
        dsn => $dsn
    ); 
}

sub init {
    my $class = shift;
    my $config = $class->config;
    $config->{model} ||= "Apache::MVC::Model::CDBI";
    $config->{view}  ||= "Apache::MVC::View::TT";
    $config->{model}->require;
    $config->{view}->require;
    $config->{classes} = [ $class->config->{loader}->classes ];
    $config->{display_tables} ||= [ $class->config->{loader}->tables ];
    for my $subclass (@{$config->{classes}}) {
        no strict 'refs';
        push @{$subclass."::ISA"}, $class->config->{model};
    }
    $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;
    return $status unless $status == OK;
    $status = $r->call_authenticate;
    return $status unless $status == OK;
    $r->additional_data();
    
    $r->model_class->process($r);
    $r->view_object->process($r);
    return $r; # For debugging.
}

sub get_request {
    my $self = shift;
    require Apache; require Apache::Request; 
    $self->{ar} = Apache::Request->new(Apache->request);
}

sub parse_location {
    my $self = shift;
    my $uri = $self->{ar}->path_info();
    my @pi = split /\//, $uri;
    shift @pi while @pi and !$pi[0];
    $self->{table} = shift @pi;
    $self->{action} = shift @pi;
    $self->{args} = \@pi;

    $self->{params} = $self->{ar}->content;
}

sub is_applicable {
    my $self = shift;
    my $config = $self->config;
    my %ok = map {$_ => 1} @{$config->{display_tables}};
    return DECLINED() unless exists $ok{$self->{table}};

    # Does the action method exist?
    my $cv = $self->model_class->can($self->{action});
    return DECLINED() unless $cv;

    # Is it exported?
    $self->{method_attribs} = join " ", attributes::get($cv);
    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;
