]> git.decadent.org.uk Git - maypole.git/blob - lib/Maypole/Manual/Request.pod
d3d66f299c66d6116d27c2ba1dba747b23226471
[maypole.git] / lib / Maypole / Manual / Request.pod
1 =head1 Maypole Request Hacking Cookbook
2
3 Hacks; design patterns; recipes: call it what you like, this chapter is a
4 developing collection of techniques which can be slotted in to Maypole
5 applications to solve common problems or make the development process easier.
6
7 As Maypole developers, we don't necessarily know the "best practice" for
8 developing Maypole applications ourselves, in the same way that Larry Wall
9 didn't know all about the best Perl programming style as soon as he wrote
10 Perl. These techniques are what we're using at the moment, but they may
11 be refined, modularized, or rendered irrelevant over time. But they've
12 certainly saved us a bunch of hours work.
13
14 =head2 Frontend hacks
15
16 These hacks deal with changing the way Maypole relates to the outside world;
17 alternate front-ends to the Apache and CGI interfaces, or subclassing chunks
18 of the front-end modules to alter Maypole's behaviour in particular ways.
19
20 =head3 Separate model class modules
21
22 You want to put all the C<BeerDB::Beer> routines in a separate module,
23 so you say:
24
25     package BeerDB::Beer;
26     BeerDB::Beer->has_a(brewery => "BeerDB::Brewery");
27     sub foo :Exported {}
28
29 And in F<BeerDB.pm>, you put:
30
31     use BeerDB::Beer;
32
33 It doesn't work.
34
35 B<Solution>: It doesn't work because of the timing of the module loading.
36 C<use BeerDB::Beer> will try to set up the C<has_a> relationships
37 at compile time, when the database tables haven't even been set up,
38 since they're set up by
39
40     BeerDB->setup("...")
41
42 which does its stuff at runtime. There are two ways around this; you can
43 either move the C<setup> call to compile time, like so:
44
45     BEGIN { BeerDB->setup("...") }
46
47 or move the module loading to run-time (my preferred solution):
48
49     BeerDB->setup("...");
50     BeerDB::Beer->require;
51
52 =head3 Debugging with the command line
53
54 You're seeing bizarre problems with Maypole output, and you want to test it in
55 some place outside of the whole Apache/mod_perl/HTTP/Internet/browser circus.
56
57 B<Solution>: Use the L<Maypole::CLI> module to go directly from a URL to
58 standard output, bypassing Apache and the network altogether.
59
60 L<Maypole::CLI> is not a standalone front-end, but to allow you to debug your
61 applications without having to change the front-end they use, it temporarily
62 "borgs" an application. If you run it from the command line, you're expected
63 to use it like so:
64
65     perl -MMaypole::CLI=Application -e1 'http://your.server/path/table/action'
66
67 For example:
68
69     perl -MMaypole::CLI=BeerDB -e1 'http://localhost/beerdb/beer/view/1?o2=desc'
70
71 You can also use the C<Maypole::CLI> module programatically to create
72 test suites for your application. See the Maypole tests themselves or
73 the documentation to C<Maypole::CLI> for examples of this.
74
75 Don't forget also to turn on debugging output in your application:
76
77     package BeerDB;
78     use strict;
79     use warnings;
80     use Maypole::Application qw(-Debug);
81
82 =head3 Changing how URLs are parsed
83
84 You don't like the way Maypole URLs look, and want something that either
85 fits in with the rest of your site or hides the internal workings of the
86 system.
87
88 B<Solution>: So far we've been using the C</table/action/id/args> form
89 of a URL as though it was "the Maypole way"; well, there is no Maypole
90 way. Maypole is just a framework and absolutely everything about it is 
91 overridable. 
92
93 If we want to provide our own URL handling, the method to override in
94 the driver class is C<parse_path>. This is responsible for taking
95 C<$r-E<gt>path> and filling the C<table>, C<action> and C<args> slots
96 of the request object. Normally it does this just by splitting the path
97 on 'C</>' characters, but you can do it any way you want, including
98 getting the information from C<POST> form parameters or session variables. 
99
100 For instance, suppose we want our URLs to be of the form
101 C<ProductDisplay.html?id=123>, we could provide a C<parse_path> method
102 like so:
103
104     sub parse_path {
105         my $r = shift;
106         $r->path("ProductList.html") unless $r->path;
107         ($r->path =~ /^(.*?)([A-Z]\w+)\.html/);
108         $r->table(lc $1);
109         $r->action(lc $2);
110         my %query = $r->ar->args;
111         $self->args([ $query{id} ]);
112     }
113
114 This takes the path, which already has the query parameters stripped off
115 and parsed, and finds the table and action portions of the filename,
116 lower-cases them, and then grabs the C<id> from the query. Later methods
117 will confirm whether or not these tables and actions exist.
118
119 See the L<iBuySpy Portal|Maypole::Manual::BuySpy> for another
120 example of custom URL processing.
121
122 =head3 Maypole for mobile devices
123
124 You want Maypole to use different templates to display on particular
125 browsers.
126
127 B<Solution>: There are several ways to do this, but here's the neatest
128 we've found. Maypole chooses where to get its templates either by
129 looking at the C<template_root> config parameter or, if this is not
130 given, calling the C<get_template_root> method to ask the front-end to
131 try to work it out. We can give the front-end a little bit of help, by
132 putting this method in our driver class:
133
134     sub get_template_root {
135         my $r = shift;
136         my $browser = $r->headers_in->get('User-Agent');
137         if ($browser =~ /mobile|palm|nokia/i) {
138             "/home/myapp/templates/mobile";
139         } else {
140             "/home/myapp/templates/desktop";
141         }
142     }
143
144 (Maybe there's a better way to detect a mobile browser, but you get the
145 idea.)
146
147 =head2 Content display hacks
148
149 These hacks deal primarily with the presentation of data to the user,
150 modifying the F<view> template or changing the way that the results of
151 particular actions are displayed.
152
153 =head3 Null Action
154
155 You need an "action" which doesn't really do anything, but just formats
156 up a template.
157
158 B<Solution>: There are two ways to do this, depending on what precisely
159 you need. If you just need to display a template, C<Apache::Template>
160 style, with no Maypole objects in it, then you don't need to write any
161 code; just create your template, and it will be available in the usual
162 way.
163
164 If, on the other hand, you want to display some data, and what you're
165 essentially doing is a variant of the C<view> action, then you need to
166 ensure that you have an exported action, as described in the
167 L<templates and actions|Maypole::Manual::StandardTemplates/"C<view> and C<edit>">
168 chapter:
169
170     sub my_view :Exported { }
171
172 =head3 Template Switcheroo
173
174 An action doesn't have any data of its own to display, but needs to display
175 B<something>.
176
177 B<Solution>: This is an B<extremely> common hack. You've just issued an
178 action like C<beer/do_edit>, which updates the database. You don't want
179 to display a page that says "Record updated" or similar. Lesser
180 application servers would issue a redirect to have the browser request
181 C</beer/view/I<id>> instead, but we can actually modify the Maypole
182 request on the fly and, after doing the update, pretend that we were
183 going to C</beer/view/I<id>> all along. We do this by setting the
184 objects in the C<objects> slot and changing the C<template> to the
185 one we wanted to go to.
186
187 In this example from L<Flox|Maypole::Manual::Flox>, we've just
188 performed an C<accept> method on a C<Flox::Invitation> object and we
189 want to go back to viewing a user's page.
190
191     sub accept :Exported {
192         my ($self, $r) = @_;
193         my $invitation = $r->objects->[0];
194         # [... do stuff to $invitation ...]
195         $r->objects([$r->user]);
196         $r->model_class("Flox::User");
197         $r->template("view");
198     }
199
200 This hack is so common that it's expected that there'll be a neater
201 way of doing this in the future.
202
203 =head3 XSLT
204
205 Here's a hack I've used a number of times. You want to store structured
206 data in a database and to abstract out its display.
207
208 B<Solution>: You have your data as XML, because handling big chunks of
209 XML is a solved problem. Build your database schema as usual around the
210 important elements that you want to be able to search and browse on. For
211 instance, I have an XML format for songs which has a header section of
212 the key, title and so on, plus another section for the lyrics and
213 chords:
214
215     <song>
216         <header>
217             <title>Layla</title>
218             <artist>Derek and the Dominos</artist>
219             <key>Dm</key>
220         </header>
221         <lyrics>
222           <verse>...</verse>
223           <chorus>
224             <line> <sup>A</sup>Lay<sup>Dm</sup>la <sup>Bb</sup> </line> 
225             <line> <sup>C</sup>Got me on my <sup>Dm</sup>knees </line> 
226             ...
227
228 I store the title, artist and key in the database, as well as an "xml"
229 field which contains the whole song as XML.
230
231 To load the songs into the database, I can C<use> the driver class for
232 my application, since that's a handy way of setting up the database classes
233 we're going to need to use. Then the handy L<XML::TreeBuilder> will handle
234 the XML parsing for us:
235
236     use Songbook;
237     use XML::TreeBuilder;
238     my $t = XML::TreeBuilder->new;
239     $t->parse_file("songs.xml");
240
241     for my $song ($t->find("song")) {
242         my ($key) = $song->find("key"); $key &&= $key->as_text;
243         my ($title) = $song->find("title"); $title = $title->as_text;
244         my ($artist) = $song->find("artist"); $artist = $artist->as_text;
245         my ($first_line) = $song->find("line");
246         $first_line = join "", grep { !ref } $first_line->content_list;
247         $first_line =~ s/[,\.\?!]\s*$//;
248         Songbook::Song->find_or_create({
249             title => $title,
250             first_line => $first_line,
251             song_key => Songbook::SongKey->find_or_create({name => $key}),
252             artist => Songbook::Artist->find_or_create({name => $artist}),
253             xml => $song->as_XML
254         });
255     }
256
257 Now we need to set up the custom display for each song; thankfully, with
258 the L<Template::Plugin::XSLT> module, this is as simple as putting the
259 following into F<templates/song/view>:
260
261     [%
262         USE transform = XSLT("song.xsl");
263         song.xml | $transform
264     %]
265
266 We essentially pipe the XML for the selected song through to an XSL
267 transformation, and this will fill out all the HTML we need. Job done.
268
269 =head3 Displaying pictures
270
271 You want to serve a picture, a Word document, or something else which
272 doesn't have a content type of C<text/html>, out of your database.
273
274 B<Solution>: Fill the content and content-type yourself.
275
276 Here's a subroutine which displays the C<photo> for either a specified
277 user or the currently logged in user. We set the C<output> slot of the
278 Maypole request object: if this is done then the view class is not called
279 upon to process a template, since we already have some output to display.
280 We also set the C<content_type> using one from the database.
281
282     sub view_picture :Exported {
283         my ($self, $r) = @_;
284         my $user = $r->objects->[0];
285         $r->content_type($user->photo_type);
286         $r->output($user->photo);
287     }
288
289 Of course, the file doesn't necessarily need to be in the database
290 itself; if your file is stored in the filesystem, but you have a file
291 name or some other pointer in the database, you can still arrange for
292 the data to be fetched and inserted into C<$r-E<gt>output>.
293
294 =head3 REST
295
296 You want to provide a programmatic interface to your Maypole site.
297
298 B<Solution>: The best way to do this is with C<REST>, which uses a
299 descriptive URL to encode the request. For instance, in
300 L<Flox|Maypole::Manual::Flox> we
301 describe a social networking system. One neat thing you can do with
302 social networks is to use them for reputation tracking, and we can use
303 that information for spam detection. So if a message arrives from
304 C<person@someco.com>, we want to know if they're in our network of
305 friends or not and mark the message appropriately. We'll do this by
306 having a web agent (say, L<WWW::Mechanize> or L<LWP::UserAgent>) request
307 a URL of the form
308 C<http://flox.simon-cozens.org/user/relationship_by_email/person%40someco.com>.
309 Naturally, they'll need to present the appropriate cookie just like a
310 normal browser, but that's a solved problem. We're just interested in
311 the REST request.
312
313 The request will return a single integer status code: 0 if they're not
314 in the system at all, 1 if they're in the system, and 2 if they're our
315 friend.
316
317 All we need to do to implement this is provide the C<relationship_by_email>
318 action, and use it to fill in the output in the same way as we did when
319 displaying a picture. Since C<person%40someco.com> is not the ID of a
320 row in the user table, it will appear in the C<args> array:
321
322     use URI::Escape;
323     sub relationship_by_email :Exported {
324         my ($self, $r) = @_;
325         my $email = uri_unescape($r->args->[0]);
326         $r->content_type("text/plain");
327         my $user;
328         unless (($user) = Flox::User->search(email => $email)) {
329             $r->content("0\n"); return;
330         }
331
332         if ($r->user->is_friend($user)) { $r->contenti("2\n"); return; };
333         $r->content("1\n"); return;
334     }
335
336 =head3 Component-based Pages
337
338 You're designing something like a portal site which has a number of
339 components, all displaying different bits of information about different
340 objects. You want to include the output of one Maypole request call while
341 building up another. 
342
343 B<Solution>: Use L<Maypole::Plugin::Component>. By inheriting like this:
344
345     package BeerDB;
346     use Maypole::Application qw(Component);
347
348 you can call the C<component> method on the Maypole request object to
349 make a "sub-request". For instance, if you have a template
350
351     <DIV class="latestnews">
352     [% request.component("/news/latest_comp") %]
353     </DIV>
354
355     <DIV class="links">
356     [% request.component("/links/list_comp") %]
357     </DIV>
358
359 then the results of calling the C</news/latest_comp> action and template
360 will be inserted in the C<latestnews> DIV, and the results of calling
361 C</links/list_comp> will be placed in the C<links> DIV. Naturally, you're
362 responsible for exporting actions and creating templates which return 
363 fragments of HTML suitable for inserting into the appropriate locations.
364
365 Alternatively, if you've already got all the objects you need, you can
366 probably just C<[% PROCESS %]> the templates directly.
367
368 =head3 Bailing out with an error
369
370 Maypole's error handling sucks. Something really bad has happened to the
371 current request, and you want to stop processing now and tell the user about
372 it.
373
374 B<Solution>: Maypole's error handling sucks because you haven't written it
375 yet. Maypole doesn't know what you want to do with an error, so it doesn't
376 guess. One common thing to do is to display a template with an error message
377 in it somewhere.
378
379 Put this in your driver class:
380
381     sub error { 
382         my ($r, $message) = @_;
383         $r->template("error");
384         $r->template_args->{error} = $message;
385         return OK;
386     }
387
388 And then have a F<custom/error> template like so:
389
390     [% PROCESS header %]
391     <H2> There was some kind of error... </H2>
392     <P>
393     I'm sorry, something went so badly wrong, we couldn't recover. This
394     may help:
395     </P>
396     <DIV CLASS="messages"> [% error %] </DIV>
397
398 Now in your actions you can say things like this:
399
400     if (1 == 0) { return $r->error("Sky fell!") }
401
402 This essentially uses the template switcheroo hack to always display the
403 error template, while populating the template with an C<error> parameter.
404 Since you C<return $r-E<gt>error>, this will terminate the processing
405 of the current action.
406
407 The really, really neat thing about this hack is that since C<error>
408 returns C<OK>, you can even use it in your C<authenticate> routine:
409
410     sub authenticate {
411         my ($self, $r) = @_;
412         $r->get_user;
413         return $r->error("You do not exist. Go away.")
414             if $r->user and $r->user->status ne "real";
415         ...
416     }
417
418 This will bail out processing the authentication, the model class, and
419 everything, and just skip to displaying the error message. 
420
421 Non-showstopper errors or other notifications are best handled by tacking a
422 C<messages> template variable onto the request:
423
424     if ((localtime)[6] == 1) {
425         push @{$r->template_args->{messages}}, "Warning: Today is Monday";
426     }
427
428 Now F<custom/messages> can contain:
429
430     [% IF messages %]
431     <DIV class="messages">
432     <UL>
433         [% FOR message = messages %]
434            <LI> [% message %] </LI>
435         [% END %]
436     </UL>
437     </DIV>
438     [% END %]
439
440 And you can display messages to your user by adding C<PROCESS messages> at an
441 appropriate point in your template; you may also want to use a template
442 switcheroo to ensure that you're displaying a page that has the messages box in
443 it.
444
445 =head2 Authentication and Authorization hacks
446
447 The next series of hacks deals with providing the concept of a "user" for
448 a site, and what you do with one when you've got one.
449
450 =head3 Logging In
451
452 You need the concept of a "current user".
453
454 B<Solution>: Use something like
455 L<Maypole::Plugin::Authentication::UserSessionCookie> to authenticate
456 a user against a user class and store a current user object in the
457 request object.
458
459 C<UserSessionCookie> provides the C<get_user> method which tries to get
460 a user object, either based on the cookie for an already authenticated
461 session, or by comparing C<user> and C<password> form parameters
462 against a C<user> table in the database. Its behaviour is highly
463 customizable and described in its documentation.
464
465 =head3 Pass-through login
466
467 You want to intercept a request from a non-logged-in user and have
468 them log in before sending them on their way to wherever they were
469 originally going. Override C<Maypole::authenticate> in your driver
470 class, something like this:
471
472 B<Solution>:
473
474     use Maypole::Constants; # Otherwise it will silently fail!
475
476     sub authenticate {
477         my ($self, $r) = @_;
478         $r->get_user;
479         return OK if $r->user;
480         # Force them to the login page.
481         $r->template("login");
482         return OK;
483     }
484
485 This will display the C<login> template, which should look something
486 like this:
487
488     [% INCLUDE header %]
489
490       <h2> You need to log in </h2>
491
492     <DIV class="login">
493     [% IF login_error %]
494        <FONT COLOR="#FF0000"> [% login_error %] </FONT>
495     [% END %]
496       <FORM ACTION="[% base ; '/' ; request.path %]" METHOD="post">
497     Username: 
498         <INPUT TYPE="text" NAME="[% config.auth.user_field || "user" %]"><BR>
499     Password: <INPUT TYPE="password" NAME="password"> <BR>
500     <INPUT TYPE="submit">
501     </FORM>
502     </DIV>
503     [% INCLUDE footer %]
504
505 Notice that this request gets C<POST>ed back to wherever it came from, using
506 C<request.path>. This is because if the user submits correct credentials,
507 C<get_user> will now return a valid user object, and the request will pass
508 through unhindered to the original URL.
509
510 =head3 Logging Out
511
512 Now your users are logged in, you want a way of having them log out
513 again and taking the authentication cookie away from them, sending
514 them back to the front page as an unprivileged user.
515
516 B<Solution>: Just call the C<logout> method of
517 C<Maypole::Plugin::Authentication::UserSessionCookie>. You may also want
518 to use the template switcheroo hack to send them back to the frontpage.
519
520 =head3 Multi-level Authorization
521
522 You have both a global site access policy (for instance, requiring a
523 user to be logged in except for certain pages) and a policy for
524 particular tables. (Only allowing an admin to delete records in some
525 tables, say, or not wanting people to get at the default set of methods
526 provided by the model class.) 
527
528 You don't know whether to override the global C<authenticate> method or
529 provide one for each class.
530
531 B<Solution>: Do both.
532 Maypole checks whether there is an C<authenticate> method for the model
533 class (e.g. BeerDB::Beer) and if so calls that. If there's no such
534 method, it calls the default global C<authenticate> method in C<Maypole>,
535 which always succeeds. You can override the global method as we saw
536 above, and you can provide methods in the model classes.
537
538 To use per-table access control you can just add methods to your model
539 subclasses that specify individual policies, perhaps like this:
540
541     sub authenticate { # Ensure we can only create, reject or accept
542         my ($self, $r) = @_;
543         return OK if $r->action =~ /^(issue|accept|reject|do_edit)$/;
544         return; # fail if any other action
545     }
546
547 If you define a method like this, the global C<authenticate> method will
548 not be called, so if you want it to be called you need to do so
549 explicitly:
550
551     sub authenticate { # Ensure we can only create, reject or accept
552         my ($self, $r) = @_;
553         return unless $r->authenticate($r) == OK; # fail if not logged in
554         # now it's safe to use $r->user
555         return OK if $r->action =~ /^(accept|reject)$/
556             or ($r->user eq 'fred' and $r->action =~ /^(issue|do_edit)$/);
557         return; # fail if any other action
558     }
559
560 =head2 Creating and editing hacks
561
562 These hacks particularly deal with issues related to the C<do_edit>
563 built-in action.
564
565 =head3 Limiting data for display
566
567 You want the user to be able to type in some text that you're later
568 going to display on the site, but you don't want them to stick images in
569 it, launch cross-site scripting attacks or otherwise insert messy HTML.
570
571 B<Solution>: Use the L<CGI::Untaint::html> module to sanitize the HTML
572 on input. C<CGI::Untaint::html> uses L<HTML::Sanitizer> to ensure that
573 tags are properly closed and can restrict the use of certain tags and
574 attributes to a pre-defined list.
575
576 Simply replace:
577
578     App::Table->untaint_columns(
579         text      => [qw/name description/]
580     );
581
582 with:
583
584     App::Table->untaint_columns(
585         html      => [qw/name description/]
586     );
587
588 And incoming HTML will be checked and cleaned before it is written to
589 the database.
590
591 =head3 Getting data from external sources
592
593 You want to supplement the data received from a form with additional
594 data from another source.
595
596 B<Solution>: Munge the contents of C< $r-E<gt>params > before jumping
597 to the original C<do_edit> routine. For instance, in this method,
598 we use a L<Net::Amazon> object to fill in some fields of a database row
599 based on an ISBN:
600
601     sub create_from_isbn :Exported {
602        my ($self, $r) = @_;
603        my $response = $ua->search(asin => $r->params->{isbn});
604        my ($prop) = $response->properties;
605        # Rewrite the CGI parameters with the ones from Amazon
606        @{$r->params->{qw(title publisher author year)} =            
607            ($prop->title,
608            $prop->publisher,
609            (join "/", $prop->authors()),
610            $prop->year());
611        # And jump to the usual edit/create routine
612        $self->do_edit($r);
613     }
614
615 The request will carry on as though it were a normal C<do_edit> POST, but
616 with the additional fields we have provided.
617 You might also want to add a template switcheroo so the user can verify
618 the details you imported.
619
620 =head3 Catching errors in a form
621
622 A user has submitted erroneous input to an edit/create form. You want to
623 send him back to the form with errors displayed against the erroneous
624 fields, but have the other fields maintain the values that the user
625 submitted.
626
627 B<Solution>: This is basically what the default C<edit> template and
628 C<do_edit> method conspire to do, but it's worth highlighting again how
629 they work. 
630
631 If there are any errors, these are placed in a hash, with each error
632 keyed to the erroneous field. The hash is put into the template as
633 C<errors>, and we process the same F<edit> template again:
634
635         $r->template_args->{errors} = \%errors;
636         $r->template("edit");
637
638 This throws us back to the form, and so the form's template should take
639 note of the errors, like so:
640
641      FOR col = classmetadata.columns;
642         NEXT IF col == "id";
643         "<P>";
644         "<B>"; classmetadata.colnames.$col; "</B>";
645         ": ";
646             item.to_field(col).as_HTML;
647         "</P>";
648         IF errors.$col;
649             "<FONT COLOR=\"#ff0000\">"; errors.$col; "</FONT>";
650         END;
651     END;
652
653 If we're designing our own templates, instead of using generic ones, we
654 can make this process a lot simpler. For instance:
655
656     <TR><TD>
657     First name: <INPUT TYPE="text" NAME="forename">
658     </TD>
659     <TD>
660     Last name: <INPUT TYPE="text" NAME="surname">
661     </TD></TR>
662
663     [% IF errors.forename OR errors.surname %]
664         <TR>
665         <TD><SPAN class="error">[% errors.forename %]</SPAN> </TD>
666         <TD><SPAN class="error">[% errors.surname %]</SPAN> </TD>
667         </TR>
668     [% END %]
669
670 The next thing we want to do is to put the originally-submitted values
671 back into the form. We can do this relatively easily because Maypole
672 passes the Maypole request object to the form, and the POST parameters
673 are going to be stored in a hash as C<request.params>. Hence:
674
675     <TR><TD>
676     First name: <INPUT TYPE="text" NAME="forename"
677     VALUE="[%request.params.forename%]">
678     </TD>
679     <TD>
680     Last name: <INPUT TYPE="text" NAME="surname"
681     VALUE="[%request.params.surname%]"> 
682     </TD></TR>
683
684 Finally, we might want to only re-fill a field if it is not erroneous, so
685 that we don't get the same bad input resubmitted. This is easy enough:
686
687     <TR><TD>
688     First name: <INPUT TYPE="text" NAME="forename"
689     VALUE="[%request.params.forename UNLESS errors.forename%]">
690     </TD>
691     <TD>
692     Last name: <INPUT TYPE="text" NAME="surname"
693     VALUE="[%request.params.surname UNLESS errors.surname%]"> 
694     </TD></TR>
695
696 =head3 Uploading files and other data
697
698 You want the user to be able to upload files to store in the database.
699
700 B<Solution>: It's messy.
701
702 First, we set up an upload form, in an ordinary dummy action. Here's
703 the action:
704
705     sub upload_picture : Exported {}
706
707 And here's the F<custom/upload_picture> template:
708
709     <FORM action="/user/do_upload" enctype="multipart/form-data" method="POST">
710
711     <P> Please provide a picture in JPEG, PNG or GIF format:
712     </P>
713     <INPUT TYPE="file" NAME="picture">
714     <BR>
715     <INPUT TYPE="submit">
716     </FORM>
717
718 (Although you'll probably want a bit more HTML around it than that.)
719
720 Now we need to write the C<do_upload> action. At this point we have to get a
721 little friendly with the front-end system. If we're using L<Apache::Request>,
722 then the C<upload> method of the C<Apache::Request> object (which
723 L<Apache::MVC> helpfully stores in C<$r-E<gt>{ar}>) will work for us:
724
725     sub do_upload :Exported {
726         my ($class, $r) = @_;
727         my $user = $r->user;
728         my $upload = $r->ar->upload("picture");
729
730 This returns a L<Apache::Upload> object, which we can query for its
731 content type and a file handle from which we can read the data. It's
732 also worth checking the image isn't going to be too massive before we
733 try reading it and running out of memory, and that the content type is
734 something we're prepared to deal with. 
735
736     if ($upload) {
737         my $ct = $upload->info("Content-type");
738         return $r->error("Unknown image file type $ct")
739             if $ct !~ m{image/(jpeg|gif|png)};
740         return $r->error("File too big! Maximum size is ".MAX_IMAGE_SIZE)
741             if $upload->size > MAX_IMAGE_SIZE;
742
743         my $fh = $upload->fh;
744         my $image = do { local $/; <$fh> };
745
746 Don't forget C<binmode()> in there if you're on a platform that needs it.
747 Now we can store the content type and data into our database, store it
748 into a file, or whatever:
749
750         $r->user->photo_type($ct);
751         $r->user->photo($image);
752     }
753
754 And finally, we use our familiar template switcheroo hack to get back to
755 a useful page:
756
757         $r->objects([ $user ]);
758         $r->template("view");
759     }
760
761 Now, as we've mentioned, this only works because we're getting familiar with
762 C<Apache::Request> and its C<Apache::Upload> objects. If we're using
763 L<CGI::Maypole> instead, we can write the action in a similar style:
764
765     sub do_upload :Exported {
766         my ($class, $r) = @_;
767         my $user = $r->user;
768         my $cgi = $r->cgi;
769         if ($cgi->upload == 1) { # if there was one file uploaded
770             my $filename = $cgi->param('picture');
771             my $ct = $cgi->upload_info($filename, 'mime');
772             return $r->error("Unknown image file type $ct")
773                 if $ct !~ m{image/(jpeg|gif|png)};
774             return $r->error("File too big! Maximum size is ".MAX_IMAGE_SIZE)
775                 if $cgi->upload_info($filename, 'size') > MAX_IMAGE_SIZE;
776             my $fh = $cgi->upload($filename);
777             my $image = do { local $/; <$fh> };
778             $r->user->photo_type($ct);
779             $r->user->photo($image);
780         }
781
782         $r->objects([ $user ]);
783         $r->template("view");
784     }
785
786 It's easy to adapt this to upload multiple files if desired.
787 You will also need to enable uploads in your driver initialization,
788 with the slightly confusing statement:
789
790     $CGI::Simple::DISABLE_UPLOADS = 0; # enable uploads
791
792 Combine with the "Displaying pictures" hack above for a happy time.
793
794 =head2 Links
795
796 L<Contents|Maypole::Manual>,
797 Next L<Flox|Maypole::Manual::Flox>,
798 Previous L<The Beer Database, Twice|Maypole::Manual::Beer>
799
800