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