]> git.decadent.org.uk Git - maypole.git/blob - lib/Maypole/Manual/Request.pod
Simplified Net::Amazon example (bug 14073)
[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     use Net::Amazon;
606     my $amazon = Net::Amazon->new(token => 'YOUR_AMZN_TOKEN');
607
608     ...
609
610     sub create_from_isbn :Exported {
611        my ($self, $r) = @_;
612        my $book_info = $amazon->search(asin => $r->params->{isbn})->properties;
613
614        # Rewrite the CGI parameters with the ones from Amazon
615        $r->params->{title} = $book_info->title;
616        $r->params->{publisher} = $book_info->publisher;
617        $r->params->{year} = $book_info->year;
618        $r->params->{author} = join('and', $book_info->authors());
619  
620        # And jump to the usual edit/create routine
621        $self->do_edit($r);
622     }
623
624 The request will carry on as though it were a normal C<do_edit> POST, but
625 with the additional fields we have provided.
626 You might also want to add a template switcheroo so the user can verify
627 the details you imported.
628
629 =head3 Catching errors in a form
630
631 A user has submitted erroneous input to an edit/create form. You want to
632 send him back to the form with errors displayed against the erroneous
633 fields, but have the other fields maintain the values that the user
634 submitted.
635
636 B<Solution>: This is basically what the default C<edit> template and
637 C<do_edit> method conspire to do, but it's worth highlighting again how
638 they work. 
639
640 If there are any errors, these are placed in a hash, with each error
641 keyed to the erroneous field. The hash is put into the template as
642 C<errors>, and we process the same F<edit> template again:
643
644         $r->template_args->{errors} = \%errors;
645         $r->template("edit");
646
647 This throws us back to the form, and so the form's template should take
648 note of the errors, like so:
649
650      FOR col = classmetadata.columns;
651         NEXT IF col == "id";
652         "<P>";
653         "<B>"; classmetadata.colnames.$col; "</B>";
654         ": ";
655             item.to_field(col).as_HTML;
656         "</P>";
657         IF errors.$col;
658             "<FONT COLOR=\"#ff0000\">"; errors.$col; "</FONT>";
659         END;
660     END;
661
662 If we're designing our own templates, instead of using generic ones, we
663 can make this process a lot simpler. For instance:
664
665     <TR><TD>
666     First name: <INPUT TYPE="text" NAME="forename">
667     </TD>
668     <TD>
669     Last name: <INPUT TYPE="text" NAME="surname">
670     </TD></TR>
671
672     [% IF errors.forename OR errors.surname %]
673         <TR>
674         <TD><SPAN class="error">[% errors.forename %]</SPAN> </TD>
675         <TD><SPAN class="error">[% errors.surname %]</SPAN> </TD>
676         </TR>
677     [% END %]
678
679 The next thing we want to do is to put the originally-submitted values
680 back into the form. We can do this relatively easily because Maypole
681 passes the Maypole request object to the form, and the POST parameters
682 are going to be stored in a hash as C<request.params>. Hence:
683
684     <TR><TD>
685     First name: <INPUT TYPE="text" NAME="forename"
686     VALUE="[%request.params.forename%]">
687     </TD>
688     <TD>
689     Last name: <INPUT TYPE="text" NAME="surname"
690     VALUE="[%request.params.surname%]"> 
691     </TD></TR>
692
693 Finally, we might want to only re-fill a field if it is not erroneous, so
694 that we don't get the same bad input resubmitted. This is easy enough:
695
696     <TR><TD>
697     First name: <INPUT TYPE="text" NAME="forename"
698     VALUE="[%request.params.forename UNLESS errors.forename%]">
699     </TD>
700     <TD>
701     Last name: <INPUT TYPE="text" NAME="surname"
702     VALUE="[%request.params.surname UNLESS errors.surname%]"> 
703     </TD></TR>
704
705 =head3 Uploading files and other data
706
707 You want the user to be able to upload files to store in the database.
708
709 B<Solution>: It's messy.
710
711 First, we set up an upload form, in an ordinary dummy action. Here's
712 the action:
713
714     sub upload_picture : Exported {}
715
716 And here's the F<custom/upload_picture> template:
717
718     <FORM action="/user/do_upload" enctype="multipart/form-data" method="POST">
719
720     <P> Please provide a picture in JPEG, PNG or GIF format:
721     </P>
722     <INPUT TYPE="file" NAME="picture">
723     <BR>
724     <INPUT TYPE="submit">
725     </FORM>
726
727 (Although you'll probably want a bit more HTML around it than that.)
728
729 Now we need to write the C<do_upload> action. At this point we have to get a
730 little friendly with the front-end system. If we're using L<Apache::Request>,
731 then the C<upload> method of the C<Apache::Request> object (which
732 L<Apache::MVC> helpfully stores in C<$r-E<gt>{ar}>) will work for us:
733
734     sub do_upload :Exported {
735         my ($class, $r) = @_;
736         my $user = $r->user;
737         my $upload = $r->ar->upload("picture");
738
739 This returns a L<Apache::Upload> object, which we can query for its
740 content type and a file handle from which we can read the data. It's
741 also worth checking the image isn't going to be too massive before we
742 try reading it and running out of memory, and that the content type is
743 something we're prepared to deal with. 
744
745     if ($upload) {
746         my $ct = $upload->info("Content-type");
747         return $r->error("Unknown image file type $ct")
748             if $ct !~ m{image/(jpeg|gif|png)};
749         return $r->error("File too big! Maximum size is ".MAX_IMAGE_SIZE)
750             if $upload->size > MAX_IMAGE_SIZE;
751
752         my $fh = $upload->fh;
753         my $image = do { local $/; <$fh> };
754
755 Don't forget C<binmode()> in there if you're on a platform that needs it.
756 Now we can store the content type and data into our database, store it
757 into a file, or whatever:
758
759         $r->user->photo_type($ct);
760         $r->user->photo($image);
761     }
762
763 And finally, we use our familiar template switcheroo hack to get back to
764 a useful page:
765
766         $r->objects([ $user ]);
767         $r->template("view");
768     }
769
770 Now, as we've mentioned, this only works because we're getting familiar with
771 C<Apache::Request> and its C<Apache::Upload> objects. If we're using
772 L<CGI::Maypole> instead, we can write the action in a similar style:
773
774     sub do_upload :Exported {
775         my ($class, $r) = @_;
776         my $user = $r->user;
777         my $cgi = $r->cgi;
778         if ($cgi->upload == 1) { # if there was one file uploaded
779             my $filename = $cgi->param('picture');
780             my $ct = $cgi->upload_info($filename, 'mime');
781             return $r->error("Unknown image file type $ct")
782                 if $ct !~ m{image/(jpeg|gif|png)};
783             return $r->error("File too big! Maximum size is ".MAX_IMAGE_SIZE)
784                 if $cgi->upload_info($filename, 'size') > MAX_IMAGE_SIZE;
785             my $fh = $cgi->upload($filename);
786             my $image = do { local $/; <$fh> };
787             $r->user->photo_type($ct);
788             $r->user->photo($image);
789         }
790
791         $r->objects([ $user ]);
792         $r->template("view");
793     }
794
795 It's easy to adapt this to upload multiple files if desired.
796 You will also need to enable uploads in your driver initialization,
797 with the slightly confusing statement:
798
799     $CGI::Simple::DISABLE_UPLOADS = 0; # enable uploads
800
801 Combine with the "Displaying pictures" hack above for a happy time.
802
803 =head2 Links
804
805 L<Contents|Maypole::Manual>,
806 Next L<Flox|Maypole::Manual::Flox>,
807 Previous L<The Beer Database, Twice|Maypole::Manual::Beer>
808
809