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