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