]> git.decadent.org.uk Git - maypole.git/blob - lib/Maypole.pm
Improved Maypole::load_model_subclass(). Added sequence
[maypole.git] / lib / Maypole.pm
1 package Maypole;
2 use base qw(Class::Accessor::Fast Class::Data::Inheritable);
3 use UNIVERSAL::require;
4 use strict;
5 use warnings;
6 use Maypole::Config;
7 use Maypole::Constants;
8 use Maypole::Headers;
9 use URI();
10
11 our $VERSION = '2.11';
12
13 # proposed privacy conventions:
14 # - no leading underscore     - public to custom application code and plugins
15 # - single leading underscore - private to the main Maypole stack - *not*
16 #     including plugins
17 # - double leading underscore - private to the current package
18
19 =head1 NAME
20
21 Maypole - MVC web application framework
22
23 =head1 SYNOPSIS
24
25 See L<Maypole::Application>.
26
27 =head1 DESCRIPTION
28
29 This documents the Maypole request object. See the L<Maypole::Manual>, for a
30 detailed guide to using Maypole.
31
32 Maypole is a Perl web application framework similar to Java's struts. It is 
33 essentially completely abstracted, and so doesn't know anything about
34 how to talk to the outside world.
35
36 To use it, you need to create a driver package which represents your entire
37 application. This is the C<BeerDB> package used as an example in the manual.
38
39 This needs to first use L<Maypole::Application> which will make your package
40 inherit from the appropriate platform driver such as C<Apache::MVC> or
41 C<CGI::Maypole>. Then, the driver calls C<setup>.  This sets up the model classes and
42 configures your application. The default model class for Maypole uses
43 L<Class::DBI> to map a database to classes, but this can be changed by altering
44 configuration (B<before> calling setup.)
45
46
47 =head1 DOCUMENTATION AND SUPPORT
48
49 Note that some details in some of these resources may be out of date.
50
51 =over 4 
52
53 =item The Maypole Manual
54
55 The primary documentation is the Maypole manual. This lives in the 
56 C<Maypole::Manual> pod documents included with the distribution. 
57
58 =item Embedded POD
59
60 Individual packages within the distribution contain (more or less) detailed
61 reference documentation for their API.
62
63 =item Mailing lists
64
65 There are two mailing lists - maypole-devel and maypole-users - see
66 http://maypole.perl.org/?MailingList
67
68 =item The Maypole Wiki
69
70 The Maypole wiki provides a useful store of extra documentation -
71 http://maypole.perl.org
72
73 In particular, there's a FAQ (http://maypole.perl.org/?FAQ) and a cookbook
74 (http://maypole.perl.org/?Cookbook). Again, certain information on these pages
75 may be out of date.
76
77 =item Web applications with Maypole
78
79 A tutorial written by Simon Cozens for YAPC::EU 2005 -
80 http://www.droogs.org/perl/maypole/maypole-tutorial.pdf [228KB].
81
82 =item A Database-Driven Web Application in 18 Lines of Code
83
84 By Paul Barry, published in Linux Journal, March 2005.
85
86 http://www.linuxjournal.com/article/7937
87
88 "From zero to Web-based database application in eight easy steps".
89
90 Maypole won a 2005 Linux Journal Editor's Choice Award
91 (http://www.linuxjournal.com/article/8293) after featuring in this article. 
92
93 =item Build Web apps with Maypole
94
95 By Simon Cozens, on IBM's DeveloperWorks website, May 2004.
96
97 http://www-128.ibm.com/developerworks/linux/library/l-maypole/
98
99 =item Rapid Web Application Deployment with Maypole
100
101 By Simon Cozens, on O'Reilly's Perl website, April 2004.
102
103 http://www.perl.com/pub/a/2004/04/15/maypole.html
104
105 =item Authentication
106
107 Some notes written by Simon Cozens. A little bit out of date, but still 
108 very useful: http://www.droogs.org/perl/maypole/authentication.html
109
110 =item CheatSheet
111
112 There's a refcard for the Maypole (and Class::DBI) APIs on the wiki -
113 http://maypole.perl.org/?CheatSheet. Probably a little out of date now - it's a
114 wiki, so feel free to fix any errors!
115
116 =item Plugins and add-ons
117
118 There are a large and growing number of plugins and other add-on modules
119 available on CPAN - http://search.cpan.org/search?query=maypole&mode=module
120
121 =item del.icio.us
122
123 You can find a range of useful Maypole links, particularly to several thoughtful
124 blog entries, starting here: http://del.icio.us/search/?all=maypole
125
126 =item CPAN ratings
127
128 There are a couple of short reviews here:
129 http://cpanratings.perl.org/dist/Maypole
130
131 =back
132
133 =head1 DEMOS
134
135 A couple of demos are available, sometimes with source code and configs. 
136
137 =over 4 
138
139 =item http://maypole.perl.org/beerdb/
140
141 The standard BeerDB example, using the TT factory templates supplied in the
142 distribution.
143
144 =item beerdb.riverside-cms.co.uk
145
146 The standard BeerDB example, running on Mason, using the factory templates
147 supplied in the L<MasonX::Maypole> distribution.
148
149 =item beerfb.riverside-cms.co.uk
150
151 A demo of L<Maypole::FormBuilder>. This site is running on the set of Mason 
152 templates included in the L<Maypole::FormBuilder> distribution. See the 
153 synopsis of L<Maypole::Plugin::FormBuilder> for an example driver
154
155 =back
156
157 =cut
158
159 __PACKAGE__->mk_classdata($_) for qw( config init_done view_object );
160
161 __PACKAGE__->mk_accessors(
162     qw( params query objects model_class template_args output path
163         args action template error document_encoding content_type table
164         headers_in headers_out stash session)
165 );
166
167 __PACKAGE__->config( Maypole::Config->new() );
168
169 __PACKAGE__->init_done(0);
170
171 =head1 HOOKABLE METHODS
172
173 As a framework, Maypole provides a number of B<hooks> - methods that are
174 intended to be overridden. Some of these methods come with useful default
175 behaviour, others do nothing by default. Likely hooks include:
176
177     Class methods
178     -------------
179     debug 
180     setup 
181     setup_model 
182     load_model_subclass
183     init
184     
185     Instance methods
186     ----------------
187     start_request_hook
188     is_model_applicable
189     get_session
190     authenticate
191     exception
192     additional_data
193     preprocess_path
194
195 =head1 CLASS METHODS
196
197 =over 4
198
199 =item debug
200
201     sub My::App::debug {1}
202
203 Returns the debugging flag. Override this in your application class to
204 enable/disable debugging.
205
206 You can also set the C<debug> flag via L<Maypole::Application>.
207
208 =cut
209
210 sub debug { 0 }      
211
212 =item config
213
214 Returns the L<Maypole::Config> object
215
216 =item setup
217
218     My::App->setup($data_source, $user, $password, \%attr);
219
220 Initialise the Maypole application and plugins and model classes - see
221 L<Maypole::Manual::Plugins>.
222
223 If your model is based on L<Maypole::Model::CDBI>, the C<\%attr> hashref can 
224 contain options that are passed directly to L<Class::DBI::Loader>, to control 
225 how the model hierarchy is constructed. 
226
227 Your application should call this B<after> setting up configuration data via
228 L<"config">.
229
230 =cut
231
232 sub setup
233 {
234     my $class = shift;
235     
236     $class->setup_model(@_);    
237 }
238
239 =item setup_model
240
241 Called by C<setup>. This method builds the Maypole model hierarchy. 
242
243 A likely target for over-riding, if you need to build a customised model.
244
245 This method also ensures any code in custom model classes is loaded, so you
246 don't need to load them in the driver.
247
248 =cut
249
250 sub setup_model 
251 {
252     my $class = shift;
253     
254     $class = ref $class if ref $class;
255     
256     my $config = $class->config;
257     
258     $config->model || $config->model('Maypole::Model::CDBI');
259     
260     $config->model->require or die sprintf 
261         "Couldn't load the model class %s: %s", $config->model, $@;
262     
263     # among other things, this populates $config->classes
264     $config->model->setup_database($config, $class, @_);
265     
266     foreach my $subclass ( @{ $config->classes } ) 
267     {
268         no strict 'refs';
269         unshift @{ $subclass . "::ISA" }, $config->model;
270         
271         # Load custom model code, if it exists - nb this must happen after the 
272         # unshift, to allow code attributes to work, but before adopt(),  
273         # in case adopt() calls overridden methods on $subclass
274         $class->load_model_subclass($subclass);
275         
276         $config->model->adopt($subclass) if $config->model->can("adopt");
277
278 #       eval "use $subclass"; 
279 #       die "Error loading $subclass: $@"  
280 #            if $@ and $@ !~ /Can\'t locate \S+ in \@INC/;
281     }
282 }
283
284 =item load_model_subclass($subclass)
285
286 This method is called from C<setup_model()>. It attempts to load the
287 C<$subclass> package, if one exists. So if you make a customized C<BeerDB::Beer>
288 package, you don't need to explicitly load it. 
289
290 If, perhaps during development, you don't want to load up custom classes, you 
291 can override this method and load them manually. 
292
293 =cut
294
295 sub load_model_subclass
296 {
297     my ($class, $subclass) = @_;
298     
299     my $config = $class->config;
300     
301     # Load any external files for the model base class or subclasses
302     # (e.g. BeerDB/DBI.pm or BeerDB/Beer.pm) based on code borrowed from
303     # Maypole::Plugin::Loader and Class::DBI.
304     if ( $subclass->require ) 
305     {
306         warn "Loaded external module for '$subclass'\n" if $class->debug > 1;
307     } 
308     else 
309     {
310         (my $filename = $subclass) =~ s!::!/!g;
311         die "Loading '$subclass' failed: $@\n"
312                unless $@ =~ /Can\'t locate \Q$filename\E\.pm/;
313         warn "Did not find external module for '$subclass'\n" 
314             if $class->debug > 1;
315    }
316 }
317
318 =item init
319
320 Loads the view class and instantiates the view object.
321
322 You should not call this directly, but you may wish to override this to add
323 application-specific initialisation - see L<Maypole::Manual::Plugins>.
324
325 =cut
326
327 sub init 
328 {
329     my $class  = shift;
330     my $config = $class->config;
331     $config->view || $config->view("Maypole::View::TT");
332     $config->view->require;
333     die "Couldn't load the view class " . $config->view . ": $@" if $@;
334     $config->display_tables
335       || $config->display_tables( $class->config->tables );
336     $class->view_object( $class->config->view->new );
337     $class->init_done(1);
338 }
339
340 =item new
341
342 Constructs a very minimal new Maypole request object.
343
344 =cut
345
346 sub new
347 {
348     my ($class) = @_;
349     
350     my $self = bless {
351         template_args => {},
352         config        => $class->config,
353     }, $class;
354     
355     return $self;
356 }
357
358 =item view_object
359
360 Get/set the Maypole::View object
361
362 =back
363
364 =head1 INSTANCE METHODS
365
366 =head2 Workflow
367
368 =over 4
369
370 =item handler
371
372 This method sets up the class if it's not done yet, sets some defaults and
373 leaves the dirty work to C<handler_guts>.
374
375 =cut
376
377 # handler() has a method attribute so that mod_perl will invoke
378 # BeerDB->handler() as a method rather than a plain function
379 # BeerDB::handler() and so this inherited implementation will be
380 # found. See e.g. "Practical mod_perl" by Bekman & Cholet for
381 # more information <http://modperlbook.org/html/ch25_01.html>
382 sub handler : method 
383 {
384     # See Maypole::Workflow before trying to understand this.
385     my ($class, $req) = @_;
386     
387     $class->init unless $class->init_done;
388
389     my $self = $class->new;
390     
391     # initialise the request
392     $self->headers_out(Maypole::Headers->new);
393     $self->get_request($req);
394     $self->parse_location;
395     
396     # hook useful for declining static requests e.g. images
397     my $status = $self->start_request_hook;
398     return $status unless $status == Maypole::Constants::OK();
399     
400     $self->session($self->get_session);
401     
402     $status = $self->handler_guts;
403     
404     # moving this here causes unit test failures - need to check why
405     # before committing the move
406     #$status = $self->__call_process_view unless $self->output;
407     
408     return $status unless $status == OK;
409     
410     # TODO: require send_output to return a status code
411     $self->send_output;
412     
413     return $status;
414 }
415
416 =item handler_guts
417
418 This is the main request handling method and calls various methods to handle the
419 request/response and defines the workflow within Maypole.
420
421 B<Currently undocumented and liable to be refactored without warning>.
422
423 =cut
424
425 # The root of all evil
426 sub handler_guts 
427 {
428     my ($self) = @_;
429     
430     $self->__load_request_model;
431
432     my $applicable = $self->is_model_applicable;
433     
434     $self->__setup_plain_template unless $applicable;
435
436     my $status;
437
438     eval { $status = $self->call_authenticate };
439     
440     if ( my $error = $@ ) 
441     {
442         $status = $self->call_exception($error);
443         
444         if ( $status != OK ) 
445         {
446             warn "caught authenticate error: $error";
447             return $self->debug ? 
448                     $self->view_object->error($self, $error) : ERROR;
449         }
450     }
451     
452     if ( $self->debug and $status != OK and $status != DECLINED ) 
453     {
454         $self->view_object->error( $self,
455             "Got unexpected status $status from calling authentication" );
456     }
457     
458     return $status unless $status == OK;
459
460     # We run additional_data for every request
461     $self->additional_data;
462     
463     if ($applicable) 
464     {
465         eval { $self->model_class->process($self) };
466         
467         if ( my $error = $@ ) 
468         {
469             $status = $self->call_exception($error);
470             
471             if ( $status != OK ) 
472             {
473                 warn "caught model error: $error";
474                 return $self->debug ? 
475                     $self->view_object->error($self, $error) : ERROR;
476             }
477         }
478     }
479     
480     # less frequent path - perhaps output has been set to an error message
481     return OK if $self->output;
482     
483     # normal path - no output has been generated yet
484     return $self->__call_process_view;
485 }
486
487 sub __load_request_model
488 {
489     my ($self) = @_;
490     $self->model_class( $self->config->model->class_of($self, $self->table) );
491 }
492
493 # is_applicable() returned false, so set up a plain template. Model processing 
494 # will be skipped, but need to remove the model anyway so the template can't 
495 # access it. 
496 sub __setup_plain_template
497 {
498     my ($self) = @_;
499     
500     # It's just a plain template
501     $self->model_class(undef);
502     
503     my $path = $self->path;
504     $path =~ s{/$}{};    # De-absolutify
505     $self->path($path);
506     
507     $self->template($self->path);
508 }
509
510 # The model has been processed or skipped (if is_applicable returned false), 
511 # any exceptions have been handled, and there's no content in $self->output
512 sub __call_process_view
513 {
514     my ($self) = @_;
515     
516     my $status;
517     
518     eval { $status = $self->view_object->process($self) };
519     
520     if ( my $error = $@ ) 
521     {
522         $status = $self->call_exception($error);
523         
524         if ( $status != OK ) 
525         {
526             warn "caught view error: $error" if $self->debug;
527             return $self->debug ? 
528                 $self->view_object->error($self, $error) : ERROR;
529         }
530     }
531     
532     return $status;
533 }
534
535 =item get_request
536
537 You should only need to define this method if you are writing a new
538 Maypole backend. It should return something that looks like an Apache
539 or CGI request object, it defaults to blank.
540
541 =cut
542
543 sub get_request { }
544
545 =item parse_location
546
547 Turns the backend request (e.g. Apache::MVC, Maypole, CGI) into a Maypole
548 request. It does this by setting the C<path>, and invoking C<parse_path> and
549 C<parse_args>.
550
551 You should only need to define this method if you are writing a new Maypole
552 backend.
553
554 =cut
555
556 sub parse_location 
557 {
558     die "parse_location is a virtual method. Do not use Maypole directly; " . 
559                 "use Apache::MVC or similar";
560 }
561
562 =item start_request_hook
563
564 This is called immediately after setting up the basic request. The default
565 method simply returns C<Maypole::Constants::OK>.
566
567 Any other return value causes Maypole to abort further processing of the
568 request. This is useful for filtering out requests for static files, e.g.
569 images, which should not be processed by Maypole or by the templating engine:
570
571     sub start_request_hook
572     {
573         my ($r) = @_;
574         
575         return Maypole::Constants::DECLINED if $r->path =~ /\.jpg$/;
576         return Maypole::Constants::OK;
577     }
578
579 =cut
580
581 sub start_request_hook { Maypole::Constants::OK }
582
583 =item is_applicable
584
585 B<This method is deprecated> as of version 2.11. If you have overridden it,
586 please override C<is_model_applicable> instead, and change the return type
587 from a Maypole:Constant to a true/false value.
588
589 Returns a Maypole::Constant to indicate whether the request is valid.
590
591 =item is_model_applicable
592
593 Returns true or false to indicate whether the request is valid.
594
595 The default implementation checks that C<< $r->table >> is publicly
596 accessible and that the model class is configured to handle the
597 C<< $r->action >>.
598
599 =cut
600
601 sub is_model_applicable 
602 {
603     my ($self) = @_;
604     
605     # cater for applications that are using obsolete version
606     if ($self->can('is_applicable')) 
607     {
608         warn "DEPRECATION WARNING: rewrite is_applicable to the interface ".
609                 "of Maypole::is_model_applicable\n";
610         return $self->is_applicable == OK;
611     }
612
613     # Establish which tables should be processed by the model
614     my $config = $self->config;
615     
616     $config->ok_tables || $config->ok_tables( $config->display_tables );
617     
618     $config->ok_tables( { map { $_ => 1 } @{ $config->ok_tables } } )
619         if ref $config->ok_tables eq "ARRAY";
620         
621     my $ok_tables = $config->ok_tables;
622       
623     # Does this request concern a table to be processed by the model?
624     my $table = $self->table;
625     
626     my $ok = 0;
627     
628     if (exists $ok_tables->{$table}) 
629     {
630         $ok = 1;
631     } 
632
633     if (not $ok) 
634     {
635         warn "We don't have that table ($table).\n"
636             . "Available tables are: "
637             . join( ",", keys %$ok_tables )
638                 if $self->debug and not $ok_tables->{$table};
639                 
640         return 0;
641     }
642     
643     # Is the action public?
644     my $action = $self->action;
645     return 1 if $self->model_class->is_public($action);
646     
647     warn "The action '$action' is not applicable to the table $table"
648         if $self->debug;
649     
650     return 0;
651 }
652
653 =item get_session
654
655 The default method is empty. 
656
657 =cut
658
659 sub get_session { }
660
661 =item call_authenticate
662
663 This method first checks if the relevant model class
664 can authenticate the user, or falls back to the default
665 authenticate method of your Maypole application.
666
667 =cut
668
669 sub call_authenticate 
670 {
671     my ($self) = @_;
672
673     # Check if we have a model class with an authenticate() to delegate to
674     return $self->model_class->authenticate($self) 
675         if $self->model_class and $self->model_class->can('authenticate');
676     
677     # Interface consistency is a Good Thing - 
678     # the invocant and the argument may one day be different things 
679     # (i.e. controller and request), like they are when authenticate() 
680     # is called on a model class (i.e. model and request)
681     return $self->authenticate($self);   
682 }
683
684 =item authenticate
685
686 Returns a Maypole::Constant to indicate whether the user is authenticated for
687 the Maypole request.
688
689 The default implementation returns C<OK>
690
691 =cut
692
693 sub authenticate { return OK }
694
695
696 =item call_exception
697
698 This model is called to catch exceptions, first after authenticate, then after
699 processing the model class, and finally to check for exceptions from the view
700 class.
701
702 This method first checks if the relevant model class
703 can handle exceptions the user, or falls back to the default
704 exception method of your Maypole application.
705
706 =cut
707
708 sub call_exception 
709 {
710     my ($self, $error) = @_;
711
712     # Check if we have a model class with an exception() to delegate to
713     if ( $self->model_class && $self->model_class->can('exception') )
714     {
715         my $status = $self->model_class->exception( $self, $error );
716         return $status if $status == OK;
717     }
718     
719     return $self->exception($error);
720 }
721
722 =item exception
723
724 This method is called if any exceptions are raised during the authentication or
725 model/view processing. It should accept the exception as a parameter and return
726 a Maypole::Constant to indicate whether the request should continue to be
727 processed.
728
729 =cut
730
731 sub exception { return ERROR }
732
733 =item additional_data
734
735 Called before the model processes the request, this method gives you a chance to
736 do some processing for each request, for example, manipulating C<template_args>.
737
738 =cut
739
740 sub additional_data { }
741
742 =item send_output
743
744 Sends the output and additional headers to the user.
745
746 =cut
747
748 sub send_output {
749     die "send_output is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
750 }
751
752
753
754
755 =back
756
757 =head2 Path processing and manipulation
758
759 =over 4
760
761 =item path
762
763 Returns the request path
764
765 =item parse_path
766
767 Parses the request path and sets the C<args>, C<action> and C<table>
768 properties. Calls C<preprocess_path> before parsing path and setting properties.
769
770 =cut
771
772 sub parse_path 
773 {
774     my ($self) = @_;
775     
776     # Previous versions unconditionally set table, action and args to whatever 
777     # was in @pi (or else to defaults, if @pi is empty).
778     # Adding preprocess_path(), and then setting table, action and args 
779     # conditionally, broke lots of tests, hence this:
780     $self->$_(undef) for qw/action table args/;
781     
782     $self->preprocess_path;
783
784     $self->path || $self->path('frontpage');
785     
786     my @pi = grep {length} split '/', $self->path;
787     
788     $self->table  || $self->table(shift @pi);
789     $self->action || $self->action( shift @pi or 'index' );
790     $self->args   || $self->args(\@pi);
791 }
792
793 =item preprocess_path
794
795 Sometimes when you don't want to rewrite or over-ride parse_path but
796 want to rewrite urls or extract data from them before it is parsed.
797
798 This method is called after parse_location has populated the request
799 information and before parse_path has populated the model and action
800 information, and is passed the request object.
801
802 You can set action, args or table in this method and parse_path will
803 then leave those values in place or populate them if not present
804
805 =cut
806
807 sub preprocess_path { };
808
809 =item make_path( %args or \%args or @args )
810
811 This is the counterpart to C<parse_path>. It generates a path to use
812 in links, form actions etc. To implement your own path scheme, just override
813 this method and C<parse_path>.
814
815     %args = ( table      => $table,
816               action     => $action,        
817               additional => $additional,    # optional - generally an object ID
818               );
819               
820     \%args = as above, but a ref
821     
822     @args = ( $table, $action, $additional );   # $additional is optional
823
824 C<id> can be used as an alternative key to C<additional>.
825
826 C<$additional> can be a string, an arrayref, or a hashref. An arrayref is
827 expanded into extra path elements, whereas a hashref is translated into a query
828 string. 
829
830 =cut
831
832 sub make_path
833 {
834     my $r = shift;
835     
836     my %args;
837     
838     if (@_ == 1 and ref $_[0] and ref $_[0] eq 'HASH')
839     {
840         %args = %{$_[0]};
841     }
842     elsif ( @_ > 1 and @_ < 4 )
843     {
844         $args{table}      = shift;
845         $args{action}     = shift;
846         $args{additional} = shift;
847     }
848     else
849     {
850         %args = @_;
851     }
852     
853     do { die "no $_" unless $args{$_} } for qw( table action );    
854
855     my $additional = $args{additional} || $args{id};
856     
857     my @add = ();
858     
859     if ($additional)
860     {
861         # if $additional is a href, make_uri() will transform it into a query
862         @add = (ref $additional eq 'ARRAY') ? @$additional : ($additional);
863     }    
864     
865     my $uri = $r->make_uri($args{table}, $args{action}, @add);
866     
867     return $uri->as_string;
868 }
869
870
871
872 =item make_uri( @segments )
873
874 Make a L<URI> object given table, action etc. Automatically adds
875 the C<uri_base>. 
876
877 If the final element in C<@segments> is a hash ref, C<make_uri> will render it
878 as a query string.
879
880 =cut
881
882 sub make_uri
883 {
884     my ($r, @segments) = @_;
885
886     my $query = (ref $segments[-1] eq 'HASH') ? pop(@segments) : undef;
887     
888     my $base = $r->config->uri_base; 
889     $base =~ s|/$||;
890     
891     my $uri = URI->new($base);
892     $uri->path_segments($uri->path_segments, grep {length} @segments);
893     
894     my $abs_uri = $uri->abs('/');
895     $abs_uri->query_form($query) if $query;
896     return $abs_uri;
897 }
898
899 =item parse_args
900
901 Turns post data and query string paramaters into a hash of C<params>.
902
903 You should only need to define this method if you are writing a new Maypole
904 backend.
905
906 =cut 
907
908 sub parse_args
909 {
910     die "parse_args() is a virtual method. Do not use Maypole directly; ".
911             "use Apache::MVC or similar";
912 }
913
914 =item get_template_root
915
916 Implementation-specific path to template root.
917
918 You should only need to define this method if you are writing a new Maypole
919 backend. Otherwise, see L<Maypole::Config/"template_root">
920
921 =cut
922
923 sub get_template_root {'.'}
924
925 =back
926
927 =head2 Request properties
928
929 =over 4
930
931 =item model_class
932
933 Returns the perl package name that will serve as the model for the
934 request. It corresponds to the request C<table> attribute.
935
936
937 =item objects
938
939 Get/set a list of model objects. The objects will be accessible in the view
940 templates.
941
942 If the first item in C<$self-E<gt>args> can be C<retrieve()>d by the model
943 class, it will be removed from C<args> and the retrieved object will be added to
944 the C<objects> list. See L<Maypole::Model> for more information.
945
946 =item template_args
947
948     $self->template_args->{foo} = 'bar';
949
950 Get/set a hash of template variables.
951
952 =item stash
953
954 A place to put custom application data. Not used by Maypole itself. 
955
956 =item template
957
958 Get/set the template to be used by the view. By default, it returns
959 C<$self-E<gt>action>
960
961
962 =item error
963
964 Get/set a request error
965
966 =item output
967
968 Get/set the response output. This is usually populated by the view class. You
969 can skip view processing by setting the C<output>.
970
971 =item table
972
973 The table part of the Maypole request path
974
975 =item action
976
977 The action part of the Maypole request path
978
979 =item args
980
981 A list of remaining parts of the request path after table and action
982 have been
983 removed
984
985 =item headers_in
986
987 A L<Maypole::Headers> object containing HTTP headers for the request
988
989 =item headers_out
990
991 A L<HTTP::Headers> object that contains HTTP headers for the output
992
993 =item document_encoding
994
995 Get/set the output encoding. Default: utf-8.
996
997 =item content_type
998
999 Get/set the output content type. Default: text/html
1000
1001 =item get_protocol
1002
1003 Returns the protocol the request was made with, i.e. https
1004
1005 =cut
1006
1007 sub get_protocol {
1008   die "get_protocol is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
1009 }
1010
1011 =back
1012
1013 =head2 Request parameters
1014
1015 The source of the parameters may vary depending on the Maypole backend, but they
1016 are usually populated from request query string and POST data.
1017
1018 Maypole supplies several approaches for accessing the request parameters. Note
1019 that the current implementation (via a hashref) of C<query> and C<params> is
1020 likely to change in a future version of Maypole. So avoid direct access to these
1021 hashrefs:
1022
1023     $r->{params}->{foo}      # bad
1024     $r->params->{foo}        # better
1025
1026     $r->{query}->{foo}       # bad
1027     $r->query->{foo}         # better
1028
1029     $r->param('foo')         # best
1030
1031 =over 4
1032
1033 =item param
1034
1035 An accessor (get or set) for request parameters. It behaves similarly to
1036 CGI::param() for accessing CGI parameters, i.e.
1037
1038     $r->param                   # returns list of keys
1039     $r->param($key)             # returns value for $key
1040     $r->param($key => $value)   # returns old value, sets to new value
1041
1042 =cut
1043
1044 sub param 
1045
1046     my ($self, $key) = (shift, shift);
1047     
1048     return keys %{$self->params} unless defined $key;
1049     
1050     return unless exists $self->params->{$key};
1051     
1052     my $val = $self->params->{$key};
1053     
1054     if (@_)
1055     {
1056         my $new_val = shift;
1057         $self->params->{$key} = $new_val;
1058     }
1059     
1060     return ref $val ? @$val : ($val) if wantarray;
1061         
1062     return ref $val ? $val->[0] : $val;
1063 }
1064
1065
1066 =item params
1067
1068 Returns a hashref of request parameters. 
1069
1070 B<Note:> Where muliple values of a parameter were supplied, the C<params> value
1071 will be an array reference.
1072
1073 =item query
1074
1075 Alias for C<params>.
1076
1077 =back
1078
1079 =head3 Utility methods
1080
1081 =over 4
1082
1083 =item redirect_request
1084
1085 Sets output headers to redirect based on the arguments provided
1086
1087 Accepts either a single argument of the full url to redirect to, or a hash of
1088 named parameters :
1089
1090 $r->redirect_request('http://www.example.com/path');
1091
1092 or
1093
1094 $r->redirect_request(protocol=>'https', domain=>'www.example.com', path=>'/path/file?arguments', status=>'302', url=>'..');
1095
1096 The named parameters are protocol, domain, path, status and url
1097
1098 Only 1 named parameter is required but other than url, they can be combined as
1099 required and current values (from the request) will be used in place of any
1100 missing arguments. The url argument must be a full url including protocol and
1101 can only be combined with status.
1102
1103 =cut
1104
1105 sub redirect_request {
1106   die "redirect_request is a virtual method. Do not use Maypole directly; use Apache::MVC or similar";
1107 }
1108
1109 =item redirect_internal_request 
1110
1111 =cut
1112
1113 sub redirect_internal_request {
1114
1115 }
1116
1117
1118 =item make_random_id
1119
1120 returns a unique id for this request can be used to prevent or detect repeat
1121 submissions.
1122
1123 =cut
1124
1125 # Session and Repeat Submission Handling
1126 sub make_random_id {
1127     use Maypole::Session;
1128     return Maypole::Session::generate_unique_id();
1129 }
1130
1131 =back
1132
1133 =head1 SEQUENCE DIAGRAMS
1134
1135 See L<Maypole::Manual::Workflow> for a detailed discussion of the sequence of 
1136 calls during processing of a request. This is a brief summary:
1137
1138     INITIALIZATION
1139                                Model e.g.
1140          BeerDB           Maypole::Model::CDBI
1141            |                        |
1142    setup   |                        |
1143  o-------->||                       |
1144            || setup_model           |     setup_database() creates
1145            ||------+                |      a subclass of the Model
1146            |||<----+                |        for each table
1147            |||                      |                |
1148            |||   setup_database     |                |
1149            |||--------------------->|| 'create'      *
1150            |||                      ||----------> $subclass
1151            |||                      |                  |
1152            ||| load_model_subclass  |                  |
1153  foreach   |||------+  ($subclass)  |                  |
1154  $subclass ||||<----+               |    require       |
1155            ||||--------------------------------------->|
1156            |||                      |                  |
1157            |||   adopt($subclass)   |                  |
1158            |||--------------------->||                 |
1159            |                        |                  |
1160            |                        |                  |
1161            |-----+ init             |                  |
1162            ||<---+                  |                  |
1163            ||                       |     new          |     view_object: e.g
1164            ||---------------------------------------------> Maypole::View::TT
1165            |                        |                  |          |
1166            |                        |                  |          |
1167            |                        |                  |          |
1168            |                        |                  |          |
1169            |                        |                  |          |
1170            
1171
1172
1173     HANDLING A REQUEST
1174
1175
1176           BeerDB                                Model  $subclass  view_object
1177             |                                      |       |         |
1178     handler |                                      |       |         |
1179   o-------->| new                                  |       |         |
1180             |-----> r:BeerDB                       |       |         |
1181             |         |                            |       |         |
1182             |         |                            |       |         |
1183             |         ||                           |       |         |
1184             |         ||-----+ parse_location      |       |         |
1185             |         |||<---+                     |       |         |
1186             |         ||                           |       |         |
1187             |         ||-----+ start_request_hook  |       |         |
1188             |         |||<---+                     |       |         |
1189             |         ||                           |       |         |
1190             |         ||-----+ get_session         |       |         |
1191             |         |||<---+                     |       |         |
1192             |         ||                           |       |         |
1193             |         ||-----+ handler_guts        |       |         |
1194             |         |||<---+                     |       |         |
1195             |         |||     class_of($table)     |       |         |
1196             |         |||------------------------->||      |         |
1197             |         |||       $subclass          ||      |         |
1198             |         |||<-------------------------||      |         |
1199             |         |||                          |       |         |
1200             |         |||-----+ is_model_applicable|       |         |
1201             |         ||||<---+                    |       |         |
1202             |         |||                          |       |         |
1203             |         |||-----+ call_authenticate  |       |         |
1204             |         ||||<---+                    |       |         |
1205             |         |||                          |       |         |
1206             |         |||-----+ additional_data    |       |         |
1207             |         ||||<---+                    |       |         |
1208             |         |||             process      |       |   fetch_objects
1209             |         |||--------------------------------->||-----+  |
1210             |         |||                          |       |||<---+  |
1211             |         |||                          |       ||        |
1212             |         |||                          |       ||   $action
1213             |         |||                          |       ||-----+  |
1214             |         |||                          |       |||<---+  |
1215             |         |||                          |       |         |
1216             |         |||         process          |       |         |
1217             |         |||------------------------------------------->|| template
1218             |         |||                          |       |         ||-----+
1219             |         |||                          |       |         |||<---+
1220             |         |||                          |       |         |
1221             |         ||     send_output           |       |         |
1222             |         ||-----+                     |       |         |
1223             |         |||<---+                     |       |         |
1224    $status  |         ||                           |       |         |
1225    <------------------||                           |       |         |
1226             |         |                            |       |         |
1227             |         X                            |       |         |           
1228             |                                      |       |         |
1229             |                                      |       |         |
1230             |                                      |       |         |
1231            
1232            
1233
1234 =head1 SEE ALSO
1235
1236 There's more documentation, examples, and a information on our mailing lists
1237 at the Maypole web site:
1238
1239 L<http://maypole.perl.org/>
1240
1241 L<Maypole::Application>, L<Apache::MVC>, L<CGI::Maypole>.
1242
1243 =head1 AUTHOR
1244
1245 Maypole is currently maintained by Aaron Trevena
1246
1247 =head1 AUTHOR EMERITUS
1248
1249 Simon Cozens, C<simon#cpan.org>
1250
1251 Sebastian Riedel, C<sri#oook.de> maintained Maypole from 1.99_01 to 2.04
1252
1253 =head1 THANKS TO
1254
1255 Sebastian Riedel, Danijel Milicevic, Dave Slack, Jesse Sheidlower, Jody Belka,
1256 Marcus Ramberg, Mickael Joanne, Randal Schwartz, Simon Flack, Steve Simms,
1257 Veljko Vidovic and all the others who've helped.
1258
1259 =head1 LICENSE
1260
1261 You may distribute this code under the same terms as Perl itself.
1262
1263 =cut
1264
1265 1;