lib/Maypole.pm

   1 package Maypole;
   2 use base qw(Class::Accessor Class::Data::Inheritable);
   3 use attributes ();
   4 use UNIVERSAL::require;
   5 use Apache::Constants ":common";
   6 use strict;
   7 use warnings;
   8 our $VERSION = "0.2";
   9 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
  10 __PACKAGE__->mk_accessors ( qw( ar params query objects model_class
  11 args action template ));
  12 __PACKAGE__->config({});
  13 __PACKAGE__->init_done(0);
  14
  15
  16 sub set_database {
  17     my $calling_class = shift;
  18     $calling_class = ref $calling_class if ref $calling_class;
  19     my $config = $calling_class->config;
  20     $config->{model} ||= "Maypole::Model::CDBI";
  21     $config->{model}->require;
  22     $config->{model}->setup_database($config, $calling_class, @_);
  23     for my $subclass (@{$config->{classes}}) {
  24         no strict 'refs';
  25         unshift @{$subclass."::ISA"}, $config->{model};
  26         $config->{model}->adopt($subclass)
  27            if $config->{model}->can("adopt");
  28     }
  29 }
  30
  31 sub init {
  32     my $class = shift;
  33     my $config = $class->config;
  34     $config->{view}  ||= "Maypole::View::TT";
  35     $config->{view}->require;
  36     $config->{display_tables} ||= [ @{$class->config->{tables}} ];
  37     $class->view_object($class->config->{view}->new);
  38     $class->init_done(1);
  39
  40 }
  41
  42 sub handler {
  43     # See Maypole::Workflow before trying to understand this.
  44     my $class = shift;
  45     $class->init unless $class->init_done;
  46     my $r = bless { config => $class->config }, $class;
  47     $r->get_request();
  48     $r->parse_location();
  49
  50     $r->model_class($r->config->{model}->class_of($r, $r->{table}));
  51     my $status = $r->is_applicable;
  52     if ($status == OK) {
  53         $status = $r->call_authenticate;
  54         return $status unless $status == OK;
  55         $r->additional_data();
  56
  57         $r->model_class->process($r);
  58     } else {
  59         # Otherwise, it's just a plain template.
  60         delete $r->{model_class};
  61         $r->{path} =~ s{/}{}; # De-absolutify
  62         $r->template($r->{path});
  63     }
  64     return $r->view_object->process($r);
  65 }
  66
  67 sub get_request {
  68     my $self = shift;
  69     require Apache; require Apache::Request;
  70     $self->{ar} = Apache::Request->new(Apache->request);
  71 }
  72
  73 sub parse_location {
  74     my $self = shift;
  75     $self->{path} = $self->{ar}->uri;
  76     my $loc = $self->{ar}->location;
  77     $self->{path} =~ s/^$loc//; # I shouldn't need to do this?
  78     $self->{path} ||= "frontpage";
  79     my @pi = split /\//, $self->{path};
  80     shift @pi while @pi and !$pi[0];
  81     $self->{table} = shift @pi;
  82     $self->{action} = shift @pi;
  83     $self->{args} = \@pi;
  84
  85     $self->{params} = { $self->{ar}->content };
  86     $self->{query}  = { $self->{ar}->args };
  87 }
  88
  89 sub is_applicable {
  90     my $self = shift;
  91     my $config = $self->config;
  92     $config->{ok_tables} = {map {$_ => 1} @{$config->{display_tables}}};
  93     warn "We don't have that table ($self->{table})"
  94         unless $config->{ok_tables}{$self->{table}};
  95     return DECLINED() unless exists $config->{ok_tables}{$self->{table}};
  96
  97     # Does the action method exist?
  98     my $cv = $self->model_class->can($self->{action});
  99     warn "We don't have that action ($self->{action})" unless $cv;
 100     return DECLINED() unless $cv;
 101
 102     # Is it exported?
 103     $self->{method_attribs} = join " ", attributes::get($cv);
 104     do { warn "$self->{action} not exported";
 105     return DECLINED()
 106      } unless $self->{method_attribs} =~ /\bExported\b/i;
 107     return OK();
 108 }
 109
 110 sub call_authenticate {
 111     my $self = shift;
 112     return $self->model_class->authenticate($self) if
 113         $self->model_class->can("authenticate");
 114     return $self->authenticate();
 115 }
 116
 117 sub additional_data {}
 118
 119 sub authenticate { return OK }
 120
 121 1;
 122
 123 =head1 NAME
 124
 125 Maypole - MVC web application framework
 126
 127 =head1 SYNOPSIS
 128
 129 See L<Maypole>.
 130
 131 =head1 DESCRIPTION
 132
 133 A large number of web programming tasks follow the same sort of pattern:
 134 we have some data in a datasource, typically a relational database. We
 135 have a bunch of templates provided by web designers. We have a number of
 136 things we want to be able to do with the database - create, add, edit,
 137 delete records, view records, run searches, and so on. We have a web
 138 server which provides input from the user about what to do. Something in
 139 the middle takes the input, grabs the relevant rows from the database,
 140 performs the action, constructs a page, and spits it out.
 141
 142 Maypole aims to be the most generic and extensible "something in the
 143 middle" - an MVC-based web application framework.
 144
 145 An example would help explain this best. You need to add a product
 146 catalogue to a company's web site. Users need to list the products in
 147 various categories, view a page on each product with its photo and
 148 pricing information and so on, and there needs to be a back-end where
 149 sales staff can add new lines, change prices, and delete out of date
 150 records. So, you set up the database, provide some default templates
 151 for the designers to customize, and then write an Apache handler like
 152 this:
 153
 154     package ProductDatabase;
 155     use base 'Maypole';
 156     __PACKAGE__->set_database("dbi:mysql:products");
 157     BeerDB->config->{uri_base} = "http://your.site/catalogue/";
 158     ProductDatabase::Product->has_a("category" => ProductDatabase::Category);
 159     # ...
 160
 161     sub authenticate {
 162         my ($self, $request) = @_;
 163         return OK if $request->{ar}->get_remote_host() eq "sales.yourcorp.com";
 164         return OK if $request->{action} =~ /^(view|list)$/;
 165         return DECLINED;
 166     }
 167     1;
 168
 169 You then put the following in your Apache config:
 170
 171     <Location /catalogue>
 172         SetHandler perl-script
 173         PerlHandler ProductDatabase
 174     </Location>
 175
 176 And copy the templates found in F<templates/factory> into the
 177 F<catalogue/factory> directory off the web root. When the designers get
 178 back to you with custom templates, they are to go in
 179 F<catalogue/custom>. If you need to do override templates on a
 180 database-table-by-table basis, put the new template in
 181 F<catalogue/I<table>>.
 182
 183 This will automatically give you C<add>, C<edit>, C<list>, C<view> and
 184 C<delete> commands; for instance, a product list, go to
 185
 186     http://your.site/catalogue/product/list
 187
 188 For a full example, see the included "beer database" application.
 189
 190 =head1 HOW IT WORKS
 191
 192 There's some documentation for the workflow in L<Maypole::Workflow>,
 193 but the basic idea is that a URL part like C<product/list> gets
 194 translated into a call to C<ProductDatabase::Product-E<gt>list>. This
 195 propagates the request with a set of objects from the database, and then
 196 calls the C<list> template; first, a C<product/list> template if it
 197 exists, then the C<custom/list> and finally C<factory/list>.
 198
 199 If there's another action you want the system to do, you need to either
 200 subclass the model class, and configure your class slightly differently:
 201
 202     package ProductDatabase::Model;
 203     use base 'Maypole::Model::CDBI';
 204
 205     sub supersearch :Exported {
 206         my ($self, $request) = @_;
 207         # Do stuff, get a bunch of objects back
 208         $r->objects(\@objects);
 209         $r->template("template_name");
 210     }
 211
 212     ProductDatabase->config->{model_class} = "ProductDatabase::Model";
 213
 214 (The C<:Exported> attribute means that the method can be called via the
 215 URL C</I<table>/supersearch/...>.)
 216
 217 Alternatively, you can put the method directly into the specific model
 218 class for the table:
 219
 220     sub ProductDatabase::Product::supersearch :Exported { ... }
 221
 222 By default, the view class uses Template Toolkit as the template
 223 processor, and the model class uses C<Class::DBI>; it may help you to be
 224 familiar with these modules before going much further with this,
 225 although I expect there to be other subclasses for other templating
 226 systems and database abstraction layers as time goes on. The article at
 227 C<http://www.perl.com/pub/a/2003/07/15/nocode.html> is a great
 228 introduction to the process we're trying to automate.
 229
 230 =head1 AUTHOR
 231
 232 Simon Cozens, C<simon@cpan.org>
 233
 234 =head1 LICENSE
 235
 236 You may distribute this code under the same terms as Perl itself.