1Maypole::Manual::CookboUoske(r3)Contributed Perl DocumenMtaaytpioolne::Manual::Cookbook(3)
2
3
4

NAME

6       Maypole::Manual::Cookbook - Maypole Cookbook
7

DESCRIPTION

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