File Coverage

blib/lib/Apache2/Controller.pm

Criterion	Covered	Total	%
statement	15	15	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	20	20	100.0

line	stmt	sub	time	code
1				package Apache2::Controller;
2
3				=encoding utf8
4
5				=head1 NAME
6
7				Apache2::Controller - fast MVC-style Apache2 handler apps
8
9				=head1 VERSION
10
11				Version 1.001.001
12
13				=cut
14
15	1	1	46456	use version;
	1		2529
	1		5
16				our $VERSION = version->new('1.001.001');
17
18				=head1 INSTALLATION PRE-REQUISITES
19
20				You need mod_perl2, L and L installed to
21				build this distribution with CPAN.
22				Otherwise the Makefile.PL will not run
23				to tell you that prerequisites failed.
24				This is a drawback of using L.
25
26				=head1 SYNOPSIS
27
28				The handler IS the controller. A2C gets all the
29				abstractions out from between your controller logic and
30				the Apache2 methods to control input/output, status etc.
31				You control Apache2 directly, or use a rendering base like
32				L which gives a method
33				to render using L
34
35				For Apache2 config file setup see L,
36				which sets a PerlResponseHandler of Apache::Controller, which
37				then creates your controller object and calls the chosen
38				method for the uri.
39
40				package MyApp::C::Foo;
41				use strict;
42				use warnings FATAL => 'all';
43
44				# base Apache2::Request is optional, it would limit your
45				# choice of method names. request object is in $self->{r}
46				# if you do not choose to use it to get access to the
47				# Apache2 methods via $self.
48
49				use base qw(
50				Apache2::Controller
51				Apache2::Request
52				);
53
54				use Apache2::Const -compile => qw( :http );
55				sub allowed_methods {qw( default bar baz )}
56
57				# suppose '/foo' is the uri path dispatched to this controller
58				# and your dispatch uses Apache2::Controller::Dispatch::Simple
59
60				# http://myapp.xyz/foo/
61				sub default {
62				my ($self) = @_;
63				$self->content_type('text/plain');
64				$self->print("Hello, world!\n");
65				return Apache2::Const::HTTP_OK;
66				}
67
68				# http://myapp.xyz/foo/bar/biz/schnozz
69				sub bar {
70				my ($self, @path_args) = @_;
71				# @path_args is:
72				# qw( biz schnozz )
73				# @{ $self->{path_args} }
74				# @{ $self->pnotes->{a2c}{path_args} }
75
76				$self->content_type('text/html');
77				$self->print(q{ "WE ARE ALL KOSH" });
78				return Apache2::Const::HTTP_OK;
79				}
80
81				# http://myapp.xyz/foo/baz
82				sub baz {
83				my ($self) = @_;
84
85				return Apache2::Const::HTTP_BAD_REQUEST
86				if $self->param('goo'); # inherits Apache2::Request
87
88				return Apache2::Const::HTTP_FORBIDDEN
89				if $self->param('boz') ne 'noz';
90
91				$self->content_type('text/plain'); # inherits Apache2::RequestRec
92				$self->sendfile('/etc/passwd'); # inherits Apache2::RequestIO
93
94				return Apache2::Const::HTTP_OK;
95				}
96
97				1;
98
99				You could implement a pretty nice REST interface, or any other kind
100				of HTTP-based API, by returning the appropriate HTTP status codes.
101				See L for a list.
102
103				See L for an additional base
104				for your controller class to render HTML with L
105				auto-selecting a template from the include path based on the
106				request URI.
107
108				=head1 DESCRIPTION
109
110				Apache2::Controller is a lightweight controller framework for
111				object-oriented applications designed to run only under mod_perl
112				children in high-performance Apache2 handler modules. It features URL
113				dispatch with flexible configuration, auth plugins, a cookie tracker
114				for Apache::Session, liberty for any storage models that work under mod_perl,
115				rendering using Template Toolkit or direct printing with Apache or whatever
116				you want,
117				and base inheritance configuration allowing you to
118				construct your applications as you need, without trying to be all things
119				to all people or assimilate the world.
120				It is intended as a framework for
121				new applications specialized as Apache2 handlers, not as a means to
122				absorb existing applications or to create portable code.
123
124				Apache2::Controller instantiates the L
125				object and puts it in C<< $self->{r} >>. If you want access
126				to the methods directly via C<< $self >>, simply use
127				L as a base and it will auto-delegate
128				all the methods.
129				See L.
130
131				For using other Apache2::Controller extension methods, use
132				another base class like
133				L, provides an easy way to
134				use Template Toolkit by default to render pages, selecting templates
135				from a directory structure that corresponds to your controller URI's.
136
137				Individual controller methods can specify plain text or other
138				content types and print directly through inherited L
139				methods, if you use L as a second base and suck
140				its methods in through that module's auto-magic.
141				See L.
142
143				Instead of abstracting Rube Goldberg devices around the Apache2 mod_perl
144				methods, it stays out
145				of your way and lets you use any and all of them directly through
146				C<$self> as you see fit, if you use L as a second base.
147				But you don't have to do that, if you don't want potential namespace
148				conflicts with your uri's. For example, if you do use
149				L as a base, you couldn't have a uri 'params'
150				or 'connection', for example, if you want to be able to use
151				those Apache2 family methods. The L object
152				is always in C<< $self->{r} >> either way.
153
154				Use L from your Apache2 config file to
155				send various URI requests to your page view modules. See the
156				CONFIGURATION section below. This features a standard mechanism for uri
157				dispatch in L that does not try
158				to figure out what modules are available, but
159				simply requires you to provide a hash that maps from uri paths to
160				controller modules. Or, dispatch plugins can be created to implement
161				the dispatcher's find_controller() method in some other way, like
162				with a TRIE for big sites or using other algorithms,
163				even dynamic ones based on context from the request.
164
165				L is the base module for each controller module.
166				Depending on your dispatch mechanism, controller modules usually
167				contain a list of the method names which
168				are allowed as uri paths under the controller.
169
170				=head1 DISPATCH OF URI TO CONTROLLER
171
172				You do not put Apache2::Controller or your subclass into the
173				Apache2 server configuration. Instead you make a subclass
174				of L and use that as a
175				PerlInitHandler. It will map a URI to an appropriate
176				Apache2::Controller subclass object and method and will
177				use C<< $r->push_handlers() >> if successful to push Apache2::Controller
178				onto the modperl response handler stack, which then creates
179				the right handler object of your subclass and sends the
180				request to the right method, handling errors in a nice way.
181
182				See L
183				for more information and different types of URI dispatching.
184				Some simple types are bundled which depend on
185				the C<< allowed_methods() >> subroutine in your controller,
186				but that isn't a required feature -
187				you can also implement your own dispatch subclass which
188				does things your way, moves allowed uris around depending
189				on context in the request, or whatever.
190
191				=head1 OTHER REQUEST PHASE HANDLERS
192
193				Configure other handlers in your config file to set things up
194				before your Apache2::Controller runs.
195
196				Most of these handlers use L
197				as a base for the object, which usually does not need to
198				instantiate the L object, because they
199				usually run before the response phase, so you usually don't
200				want to parse and cache the body if you want to use input filters.
201				If your subclass methods of non-response Apache2::Controller
202				components need access to the L object C<< $r >>,
203				it is always in C<< $self->{r} >>.
204
205				Some other request phase handlers register later-stage handlers,
206				for example to save the session or rollback uncommitted database
207				transactions with C's
208				after the connection output is complete.
209
210				The controller handler returns your set HTTP status code
211				or OK (0) to Apache. In general you return the status code
212				that you want to set, or return OK. Or you can set it with
213				C<< $r->status() >> and return OK.
214				You can't return DONE or DECLINED. (If you find you need
215				to do that for some reason please contact me.)
216
217				See L
218				and L. You can also set
219				C<< status_line() >> or throw L
220				exceptions to be processed by an error template,
221				if you're using some form of template rendering - see
222				the section on errors below.
223
224				Add handlers in your config file with your own modules which
225				C to inherit from these classes as you need them:
226
227				=head2 PerlHeaderParserHandler Apache2::Controller::Session
228
229				C<< $r->pnotes->{a2c}{session} >> automatically loaded from and
230				stored to an L tied hash. Pushes a PerlLogHandler
231				to save the session after the main controller returns OK.
232
233				See L
234				and L.
235
236				=head2 PerlAuthenHandler Apache2::Controller::Authen::OpenID
237
238				Implements OpenID logins and redirects to your specified login
239				controller by changing the dispatch selection on the fly.
240
241				See L.
242
243				As for Access and Authz phases of AAA, you should
244				probably roll your own. This framework isn't going
245				to dictate the means of your data storage or how
246				you organize your users. See the mod_perl manual.
247
248				=head1 Apache2::Controller response phase handler
249
250				Apache2::Controller is set as the PerlResponseHandler if
251				the dispatch class finds a valid module and method for the request.
252
253				=head2 Subclass L
254
255				Most of the time you will want to use Apache2::Request as
256				a second base. If you do this, then your controller
257				inherits the L methods with
258				(some) modperl2 request extension libraries loaded during
259				construction, or you can use others in the package namespace
260				and automatically get the methods.
261
262				This way, you can call C<< $self->$methodname >> for any of
263				the methods associated with L,
264				L and some of their friends.
265				Watch the log for warnings about redefined subroutines, or
266				C<< use warnings FATAL => 'all' >> to keep yourself on the
267				right track.
268
269				To use a simplified example:
270
271				package MyApp::C::SomeURIController;
272				use base qw(
273				Apache2::Controller
274				Apache2::Request
275				);
276
277				my %pats = (
278				shipto => qr{ \A (.*?) \z }mxs,
279				addr => qr{ \A (.*?) \z }mxs,
280				zip => qr{ \A (\d{5}) \z }mxs,
281				);
282
283				sub set_shipping_address {
284				my ($self) = @_;
285
286				# $self->param() is Apache::Request param():
287				my ($shipto, $addr, $zip)
288				= map {
289				$self->param($_) =~ $pats{$_};
290				$1 \|\| return Apache2::Const::SERVER_ERROR;
291				} qw( shipto addr zip );
292				$self->content_type('text/plain');
293				$self->print('Your package is on its way.');
294				return Apache2::Const::HTTP_OK
295				}
296
297				At any rate, your Apache2::Controller child object
298				normally subclasses
299				itself into Apache2::Request which magically
300				delegates all those methods
301				to the internal hash value C<< $self->{r} >>, which is the actual
302				Apache2::Request object.
303				See L
304				about those gory details.
305
306				Whether
307				you call C<< $self->$apache2_request_method >> or
308				C<< $self->{r}->$apache2_request_method >> matters not,
309				you still ask the same object, so you might as well use
310				C<< $self->$method >> to make it look clean.
311
312				But, if you don't want to pollute your namespace of
313				potential URI handlers with the Apache2::Request* family
314				method namespace, don't use Apache2::Request as a base.
315				C<< $self->{r} >> is still an Apache2::Request object,
316				which gets you to all the RequestRec, RequestUtil,
317				RequestIO methods etc.
318
319				The rest of this manual assumes that you do use
320				L as a base in your controller,
321				and refers to its methods via C<< $self >>. Just
322				keep in mind that you don't have to, but can
323				access those methods via C<< $self->{r} >>.
324
325				=head1 RETURN VALUES
326
327				Your controller methods should use C<< eval { } >> if necessary and
328				act accordingly, set the right things for C
329				and return the right HTTP constant. See L
330				and L.
331
332				In the event of an error, if you wish, use L
333				and throw one with field 'status' set to a valid HTTP return code.
334				This lets you implement nice error templates if your controller uses
335				L as a base.
336				See L below.
337
338				Success in the controller method normally should just return the
339				appropriate HTTP status code. You can return HTTP_OK (200) if that
340				is what you mean, or it is the default status if you return OK (0).
341
342				Or, if you do C<< $self->status( Apache2::Const::HTTP_SOMETHING ) >>
343				and then just C<< return() >>
344				or return OK (0), Apache2::Controller will not override the set status.
345
346				See L for a list of HTTP return constants
347				and corresponding numbers and messages.
348
349				=head2 REDIRECTS, ETC.
350
351				As an example of return values, take browser redirects.
352				There's no need for an abstraction mechanism around redirects
353				since you have direct access to the Apache methods.
354
355				package MyApp::Controller::Somewhere;
356				use base qw( Apache2::Controller Apache2::Request );
357				use Apache2::Const -compile => qw( REDIRECT );
358
359				# maybe dispatched from http://myapp.xyz/somewhere/go_elsewhere
360				sub go_elsewhere {
361				my ($self, @path_args) = @_;
362				$self->err_headers_out->add(Location => 'http://foo.bar');
363				return Apache2::Const::REDIRECT;
364				}
365
366				Keep in mind that if you use other request phase processors that
367				push a C like
368				L or
369				L, those will still run,
370				but for example the session controller won't save the session
371				if you set or return an http status higher than the HTTP_OK family
372				(HTTP_MULTIPLE_CHOICES (300) or higher.)
373
374				You should also not fiddle with the connection by causing
375				Apache2 to close it prematurely, else the post-response handlers
376				may not run or won't run synchronously before another request
377				is received that may have depended on their behavior.
378				(For example, you can't use a C<< PerlCleanupHandler >>
379				to do things like that because the request has already closed,
380				and it doesn't get processed before taking in the next request,
381				even when running in single-process mode.)
382
383				=head1 ERRORS
384
385				If you decide to set an error status code, you can print your
386				own content and return that status code.
387
388				If you want to use error templates,
389				barf L objects. These print a stack trace
390				to the error log at the WARN level of L from
391				this module's namespace. If errors crop up from
392				other A2C request phase handlers, try setting
393				WARN log level for L
394				or L.
395
396				Also see L.
397
398				You can use or subclass L,
399				to use C<< a2cx() >>,
400				or you can throw your own exception objects,
401				or just C<< die() >>, or C<< croak() >>,
402				or set C<< $self->status >>, headers etc., possibly printing content,
403				or return the appropriate status from your controller method.
404
405				See L for help on throwing exceptions
406				with HTTP status, data dumps, etc.
407
408				If your code does break, die or throw an exception, this is
409				caught by Apache2::Controller. If your controller module implements
410				an C<> method,
411				then C<< $handler->error() >> will be called passing the C<< $EVAL_ERROR >>
412				or exception object as the first argument.
413
414				package MyApp::C::Foo;
415				use YAML::Syck;
416				# ...
417				sub error {
418				my ($self, $X) = @_;
419				$self->status( Apache2::Const::HTTP_BAD_REQUEST );
420				$self->content_type('text/plain');
421				$self->print("Take this job and shove it!\n", "\n", $X, "\n");
422				if ($X->isa('Apache2::Controller::X')) {
423				# usually you wouldn't show gory details to the user...
424				$self->print(Dump($X->dump)) if $X->dump;
425				$self->print($X->trace) if $X->trace;
426				}
427				}
428
429				For instance
430				L implements
431				C<< error() >> for you, which looks for
432				the appropriately named error template as
433				F.
434
435				Of course, all exceptions are sent to the error log using
436				L DEBUG() before the handler completes, and
437				any refusal status greater or equal to 400 (HTTP_BAD_REQUEST)
438				will be written to the access log with L log_reason()
439				using the first few characters of the error.
440
441				See L for how to control
442				whether or not a session is saved. Usually it is automatically
443				saved, but not if you have an error.
444
445				C<< error() >> does not have to roll back DBI handles if you
446				use L, as this is
447				rolled back automatically in the C<< PerlLogHandler >>
448				phase if you don't commit the transaction.
449
450				=head1 CONTROLLER CLOSURES
451
452				Apache2::Controller's package space structure lets you take advantage
453				of closures that access variables in your controller subclass
454				package space, which are cached by modperl in child processes
455				across independent web requests. Be careful with that and use
456				Devel::Size to keep memory usage down. I have no idea how this
457				would work under threaded mpm.
458
459				=head1 CONTENT TYPE
460
461				Your controller should set content type with C<< $self->content_type() >>
462				to something specific if you need that. Otherwise it will let
463				mod_perl set it to whatever it chooses when you start to print.
464				This is usually text/html.
465
466				=head1 LOGGING
467
468				Apache2::Controller uses L. See that module
469				for information on how to set up a format file or statement.
470				For example, in a perl startup script called at Apache2 start time,
471				do something like:
472
473				use Log::Log4perl;
474				log4perl.rootLogger=DEBUG, LogFile
475				log4perl.appender.LogFile=Log::Log4perl::Appender::File
476				log4perl.appender.LogFile.filename=/var/log/mysite_error_log
477				log4perl.appender.LogFile.layout=PatternLayout
478				log4perl.appender.LogFile.layout.ConversionPattern=%M [%L]: %m%n
479				};
480				Log::Log4perl->init(\$logconf);
481
482				These settings will be cloned to every modperl child on fork.
483
484				=head1 MVC
485
486				Apache2::Controller provides the controller, mainly.
487				L is one example
488				of a view that can be used as a second base with
489				C in your controller module. As for the Model
490				part of Model-View-Controller, Apache2::Controller leaves
491				that entirely up to you and does not force you to
492				wrap anything in an abstraction class.
493
494				The C subroutine is in your base class and your
495				controller modules will be running from memory in the mod_perl
496				child interpreter. So,
497				you can use package namespace effectively to store data
498				that will persist in the mod_perl child across requests.
499
500				=head1 LOAD BALANCING
501
502				A2C does not have to load
503				all site modules for every page handler, which could help with load-balancing
504				highly optimized handlers for specific URI's while having a universal
505				application installer.
506
507				Picture if you will, a programming utopia in which all engineers
508				are respected, highly paid and content, and managers make
509				correct decisions to rely on open-source software.
510
511				You deploy the same Apache, the
512				same CPAN modules and your whole application package to every server,
513				and attach a url-generating subroutine to the L stash
514				that puts in a different hostname when the URI is one of your
515				load-intensive functions.
516
517				easy "http://pony.x.y/easy"
518
519				hard "http://packhorse.x.y/hard"
520
521				Web designers can be taught to use this function C<< myurl() >>,
522				but system admins
523				maintain the map that it loads to figure out what servers to use.
524
525				Then the Apache2 config files on those
526				packhorse servers would pre-load only the subclassed controllers
527				that you needed, and redirect all other uri requests to the pony servers.
528
529				=cut
530
531	1	1	185	use strict;
	1		5
	1		26
532	1	1	5	use warnings FATAL => 'all';
	1		6
	1		41
533	1	1	4	use English '-no_match_vars';
	1		1
	1		7
534
535	1	1	541	use base qw( Apache2::Controller::Methods );
	1		2
	1		980
536
537				use Readonly;
538				use Scalar::Util qw( blessed );
539				use Log::Log4perl qw(:easy);
540
541				use YAML::Syck;
542				use Digest::SHA qw( sha224_base64 );
543				use URI;
544				use HTTP::Status qw( status_message );
545				use Scalar::Util qw( looks_like_number );
546
547				use Apache2::Controller::X;
548				use Apache2::Controller::Funk qw( log_bad_request_reason );
549
550				use Apache2::Request;
551				use Apache2::RequestRec ();
552				use Apache2::RequestIO ();
553				use Apache2::RequestUtil ();
554				use Apache2::Log;
555				use Apache2::Const -compile => qw( :common :http );
556
557				=head1 FUNCTIONS
558
559				=head2 a2c_new
560
561				$handler = MyApp::C::ControllerSubclass->a2c_new( Apache2::RequestRec object )
562
563				This is called by handler() to create the Apache2::Controller object
564				via the module chosen by your L subclass.
565
566				We use C<< a2c_new >> instead of the conventional C<< new >>
567				because, in case you want to suck in the L
568				methods with that module's automagic, then you don't get
569				confused about how C<> behaves. Otherwise you
570				get into a mess of keeping track of the order of bases
571				so you don't call C<< Apache2::Request->new() >> by accident,
572				which breaks everything.
573
574				=head3 subclassing C
575
576				To set params for the L object,
577				you have to subclass C.
578
579				package MyApp::ControllerBase;
580				use base qw( Apache2::Controller Apache2::Request );
581
582				sub a2c_new {
583				my ($class, $r) = @_;
584				return SUPER::new(
585				$class, $r,
586				POST_MAX => 65_535,
587				TEMP_DIR => '/dev/shm',
588				);
589				# $self is already blessed in the class hierarchy
590				}
591
592				package MyApp::Controller::SomeURI;
593				use base qw( MyApp::ControllerBase );
594				sub allowed_methods qw( uri_one uri_two );
595				sub uri_one { # ...
596
597				If you need to do the same stuff every time a request
598				starts, you can override the constructor through a
599				class hierarchy.
600
601				package MyApp::ControllerBase;
602				use base qw( Apache2::Controller Apache2::Request );
603
604				sub new {
605				my ($class, $r, @apr_override_args) = @_;
606				my $self = SUPER::new(
607				$class, $r,
608				POST_MAX => 65_535,
609				TEMP_DIR => '/dev/shm',
610				@apr_override_args,
611				);
612
613				# $self is already blessed in the class hierarchy
614
615				# do request-startup stuff common to all controller modules
616
617				return $self;
618				}
619
620				package MyApp::Controller::SomeURI;
621				use base qw( MyApp::ControllerBase );
622				sub allowed_methods qw( uri_one uri_two );
623				sub new {
624				my ($class, $r) = @_;
625
626				my $self = SUPER::a2c_new(
627				$class, $r,
628				);
629
630				# no need to bless, A2C blesses into the child class
631
632				# do request-startup stuff for this specific controller
633
634				return $self;
635				}
636
637				sub uri_one {
638				my ($self) = @_;
639				$self->content_type('image/gif');
640				# ...
641				return Apache2::Const::HTTP_OK;
642				}
643				sub uri_two { # ...
644
645				Similarly, to do something always at the end of every
646				request, from within the dispatched PerlResponseHandler:
647
648				package MyApp::Controller::SomeURI;
649				use Devel::Size;
650				use Log::Log4perl qw(:easy);
651				my $MAX = 40 * 1024 * 1024;
652				sub DESTROY {
653				my ($self) = @_;
654				my $size = total_size($self); # whoo baby!
655				INFO("size of $self->{class} is bigger than $MAX!") if $size > $MAX;
656				return; # self is destroyed
657				}
658
659				See L below for more tips.
660
661				=cut
662
663				my %temp_dirs = ( );
664				my %post_maxes = ( );
665
666				sub a2c_new {
667				my ($class, $r, @apr_opts) = @_;
668
669				DEBUG sub {
670				"new $class, reqrec is '$r', apr_opts:\n".Dump(\@apr_opts)
671				};
672
673				my $self = {
674				class => $class,
675				};
676
677				bless $self, $class;
678
679				DEBUG "creating Apache2::Request object";
680				my $req = Apache2::Request->new( $r, @apr_opts );
681				DEBUG "request object is '$req'";
682
683				$self->{r} = $req; # for Apache2::Request subclass automagic
684
685				my $pnotes_a2c = $req->pnotes->{a2c} \|\| { };
686
687				my $method = $pnotes_a2c->{method};
688
689				$self->{method} = $method;
690				$self->{path_args} = $pnotes_a2c->{path_args};
691
692				# don't instantiate the 'session' key of $self unless it's implemented
693				# in some earlier stage of the apache lifecycle.
694				my $session = $pnotes_a2c->{session};
695				if ($session) {
696				$self->{session} = $session;
697				DEBUG(sub{"found and attached session to controller self:\n".Dump($session)});
698				# this is the same reference as the pnotes reference still,
699				# so the cleanup handler will find all changes made to it
700				}
701
702				DEBUG sub { Dump({
703				# for simple debugging, stringify objects, otherwise this can get huge
704				map {($_ => defined $self->{$_} ? "$self->{$_}" : undef)} keys %$self
705				}) };
706
707				return $self;
708				}
709
710				=head1 METHODS
711
712				Methods are also extended by other modules in the A2C family.
713				See L.
714
715				=head2 handler
716
717				# called from Apache, your subclass pushed to PerlResponseHandler
718				# by your A2C dispatch handler:
719				MyApp::Controller::Foo->handler( Apache2::RequestRec object )
720
721				The handler is pushed from an Apache2::Controller::Dispatch
722				subclass and via your dispatched subclass of Apache2::Controller.
723				It should not be set in the config file. It looks
724				for the controller module name in C<< $r->pnotes->{a2c}{controller} >>
725				and for the method name in C<< $r->pnotes->{a2c}{method} >>.
726
727				Errors are intercepted and if the handler object was created
728				and implements an C<< $handler->error($exception) >> method
729				then the exception will be passed as the argument.
730
731				An HTTP status code of HTTP_BAD_REQUEST or greater will
732				cause log_reason to be called with a truncated error string
733				and the uri for recording in the access log.
734
735				=cut
736
737				my %supports_error_method = ( );
738
739				sub handler : method {
740				my ($class, $r) = @_;
741				return $class if !defined $r;
742
743				my $pnotes_a2c = $r->pnotes->{a2c} \|\| { };
744
745				my $method = $pnotes_a2c->{method};
746
747				DEBUG("$class -> $method");
748
749				my ($handler, $status, $X, $used_error_method_successfully) = ( );
750				eval {
751
752				$handler = $class->a2c_new($r);
753				$method = $handler->{method};
754
755				DEBUG("executing $class -> $method()");
756				my $args = $pnotes_a2c->{path_args} \|\| [];
757				$status = $handler->$method(@{$args});
758				$status = $r->status() if !defined $status;
759
760				if (defined $status) {
761				if (ref $status \|\| !looks_like_number($status)) {
762				a2cx message => "Controller returned or set non-numeric status",
763				status => Apache2::Const::SERVER_ERROR,
764				dump => { controller_set_status => $status };
765				}
766				elsif ($status < 0) {
767				a2cx message => "controller must set http status >= 0",
768				status => Apache2::Const::SERVER_ERROR,
769				dump => { controller_set_status => $status };
770				}
771				}
772				};
773				if ($X = $EVAL_ERROR) {
774
775				my $ref = ref($X);
776				my $blessed = $ref && blessed($X);
777
778				my $error_method_status;
779
780				# if appropriate and able to call self->error(), do that now
781				if ($handler && !$pnotes_a2c->{use_standard_errors}) {
782
783				eval {
784				if (exists $supports_error_method{$class}) {
785				$error_method_status = $handler->error($X);
786				}
787				elsif ($class->can('error')) {
788				$supports_error_method{$class} = 1;
789				$error_method_status = $handler->error($X);
790				}
791				$used_error_method_successfully = 1;
792				};
793
794				# trap unknown errors that might have been thrown
795				# by the error() subroutine
796				$X = Exception::Class->caught('Apache2::Controller::X')
797				\|\| $EVAL_ERROR
798				\|\| $X;
799				}
800
801				my $x_status = $ref && $blessed && $X->can('status')
802				? $X->status : undef;
803
804				$status
805				= defined $x_status ? $x_status
806				: defined $error_method_status ? $error_method_status
807				: !defined $status ? Apache2::Const::SERVER_ERROR
808				: $status == Apache2::Const::OK ? Apache2::Const::HTTP_OK
809				: Apache2::Const::SERVER_ERROR
810				;
811
812				WARN "Exception processing status: $status";
813
814				if ($ref && $blessed) {
815				WARN sub { "dump:\n" .Dump($X->dump) } if $X->can('dump');
816				WARN sub { "data:\n" .Dump($X->data) } if $X->can('data');
817				WARN sub { "trace:\n" .Dump($X->trace) } if $X->can('trace');
818				WARN "$X";
819				}
820				else {
821				WARN("Caught an unknown error: $X");
822				}
823				}
824
825				DEBUG("done with handler processing...");
826				DEBUG(sub {
827				my $ctype = $r->content_type();
828				"content type is ".($ctype \|\| '[undef]');
829				});
830
831				$r->status($status) if $status;
832
833				DEBUG(sub {
834				my $stat = defined $status ? $status : '';
835				my $sline = $r->status_line() \|\| '[none]';
836				my $smsg
837				= defined $status
838				? (status_message($status) \|\| '[no msg]')
839				: 'N/A';
840				my $debugstatus = defined $status ? $status : '[status not defined]';
841				"status: $debugstatus ($smsg); status_line='$sline'";
842				});
843
844				if (defined $status && $status >= Apache2::Const::HTTP_BAD_REQUEST) {
845				# if status is an error, file error (possibly truncated) as a
846				# log_reason in the access log for why this request was denied.
847				# (is this desirable?)
848				log_bad_request_reason($r, $X);
849				}
850
851				if (!defined $status) {
852				return Apache2::Const::OK;
853				}
854				elsif ($used_error_method_successfully) {
855				# if used a supplied error() method, stop the phase
856				# so Apache doesn't append its standard error messages
857				# over whatever the controller already wrote.
858				# unless there is a way to detect whether output has been written?
859				# get the position of the output handle maybe?
860				return Apache2::Const::DONE;
861				}
862				else {
863				return $status == Apache2::Const::HTTP_OK
864				? Apache2::Const::OK
865				: $status;
866				}
867
868				# supposedly you can return the http status, but it doesn't work right
869				# if you return HTTP_OK. shouldn't it?
870				}
871
872				=head1 USING INHERITANCE
873
874				There is no need for a predefined sequence of start-up or clean-up
875				routines that Apache2::Controller would have to check for in your
876				controller module.
877
878				Instead, you use inheritance to streamline your code and share
879				common pieces, like in L above.
880
881				If your methods need to do cleanup after finishing,
882				for example,
883				they should add a line to call a shared cleanup method.
884
885				package MyApp::Cleanup;
886				sub cleanup {
887				my ($self) = @_;
888				# ...
889				}
890
891				package MyApp::C::Foo;
892				use base qw( Apache2::Controller Apache2::Request MyApp::Cleanup );
893				sub allowed_methods {qw( foo bar )}
894
895				sub foo {
896				# ...
897				$self->cleanup();
898				return;
899				}
900				# or...
901				sub bar {
902				# ...
903				$self->push_handler(PerlCleanupHandler => sub {
904				# ...
905				});
906				return;
907				}
908
909				Or better yet...
910
911				package MyApp::Cleanup;
912				sub DESTROY {
913				my ($self) = @_;
914				# ...
915				}
916
917				package MyApp::C::Foo;
918				use base qw( Apache2::Controller MyApp::Cleanup );
919				sub allowed_methods {qw( foo bar )}
920
921				sub foo {
922				# ...
923				return;
924				}
925
926				sub bar {
927				# ...
928				return;
929				}
930
931				There is no need for a predefined method sequence that
932				tries to run for each request, because Apache2 already
933				provides a robust abstraction of the request lifecycle
934				with many stages for which you can register handler subroutines.
935				If you can wrap your head around it, inheritance provides many
936				solutions to problems for which elaborate measures are commonly
937				re-invented. For example if you wanted cleanup done the same way every
938				time without having to remember that C<< $self->cleanup() >> line
939				for each new
940				method, overload the constructor as per L above
941				and register a PerlCleanupHandler for every request instead,
942				or use a base with a DESTROY method.
943
944				Otherwise the framework ends up doing a lot of work every time
945				to ask, "did they implement this? did they implement that?"
946				and that gets in your way, or you have to write those routines
947				every time even if they don't do anything, or whatever. Bleah.
948				Implement what you want to implement from the controller methods.
949				The framework won't provide you with any more structure.
950
951				=head1 EXAMPLES
952
953				Browse the source package from CPAN
954				and check out t/lib/* and t/conf/extra.conf.last.in.
955
956				=head1 RELATED MODULES
957
958				L
959
960				L
961
962				L
963
964				L
965
966				L
967
968				L
969
970				L
971
972				L
973
974				L
975
976				=head1 SEE ALSO
977
978				L and friends
979
980				L
981
982				L
983
984				L
985
986				L
987
988				=head1 THANKS
989
990				Many thanks to David Ihnen, Adam Prime, André Warnier
991				and all the great people on the modperl mailing list.
992
993				Special thanks to Nobuo Danjou for Apache2::AuthenOpenID
994				which edumacated me on how the OpenID authen module
995				should work.
996
997				Super thanks to Roberto C. Sánchez for help packaging
998				up A2C for Debian distribution.
999
1000				Of course, thanks to the many mod_perl and Apache authors
1001				and all the CPAN authors whose modules this depends on.
1002				Wow! This stuff is so cool!
1003
1004				=head1 AUTHOR
1005
1006				Mark Hedges, C
1007
1008				=head1 COPYRIGHT AND LICENSE
1009
1010				Copyright 2008-2010 Mark Hedges. CPAN: markle
1011
1012				This library is free software; you can redistribute it and/or modify
1013				it under the same terms as Perl itself.
1014
1015				This software is provided as-is, with no warranty
1016				and no guarantee of fitness
1017				for any particular purpose.
1018
1019
1020				=cut
1021
1022				1;