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