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