Chapter 8: Building a Mason Site
This chapter covers, in detail, a full-fledged working web application. Our application is the Perl Apprenticeship site at http://apprentice.perl.org/. Back at O'Reilly's 2001 Open Source Conference, Adam Turoff suggested that the Perl community needed a site where people who had project ideas, but either not enough time or not enough expertise, could hook up with other programmers who could supply the missing pieces.
An experienced developer with a really neat idea and not nearly enough time to do it can post a project idea and offer to mentor a less experienced developer in its implementation. Conversely, a less experienced developer with a really neat idea who isn't quite sure how to go forward on it can look for a mentor to help him bring that idea to life.
This is a pretty basic database-backed web application, the kind of thing that
Mason gets used for all the time. It didn't require anything too terribly
complicated, but it shows off a number of Mason's features quite well,
including how components can be used to isolate individual site elements,
autohandlers and dhandlers, and a simple use of <%method> blocks.
One thing worth noting is that for database access we chose to use Alzabo, which is a project created and maintained by Dave Rolsky. Alzabo is a database-to-object mapper built on top of the DBI. It allows us to easily create Perl objects representing things in our database, like users or projects. We will not be going into detail on our schema or our Alzabo-related code here, as this is largely incidental to the goal of this chapter. Our hope is that if you don't understand any particular piece of the Alzabo functionality, you can just treat it as pseudocode.1 More information on Alzabo is available online at http://www.alzabo.org/. Alzabo is also available from the CPAN.
The code for the site is available at this book's site, http://www.masonbook.com/. This includes an installer that should help you get the site up and running without too much trouble.2
I probably would not create a site this way any more, and even back when I wrote the book I wouldn't have done it exactly the way I did. The book example intentionally put more stuff in Mason components to avoid having lots of extra modules to deal with.
Nowadays, I'd probably use Catalyst (http://catalyst.perl.org) as the framework. This means that all of the form submission handling, user auth, and other non-display code would be in Catalyst controllers, not Mason components.
Dave, 2007
Functionality
The first issue at hand is determining what sort of functionality the site has to have in order to be useful. Our site is fairly simple. It needs to implement the following features:
-
Index page
The index page will have a welcome message, site news, and a featured project selected by the site administrator.
-
Consistent and context-sensitive menu
The lefthand side of the site is a navigation menu that is context-sensitive. Logged-in users see different options than guest users. Users with site admin options see an additional set of options. However, these options remain the same from page to page.
Underneath the menu the site shows the five most recent projects entered into the system.
-
User information
Some user information will be publicly viewable. This will be users' usernames and email addresses (displayed in an altered form to protect them from robots) and the list of projects with which they are involved. Their real names are not displayed.
-
Project browsing
Since we do not anticipate an extremely large number of submissions, at least initially, we decided not to create any complicated search mechanism. The two ways to find projects will be to view a list of all the projects in the system or to browse the projects by category. The user can click on any displayed project to see more detailed information about it.
-
User accounts
Users need to be able to create new accounts, retrieve a forgotten password, log in, and log out. In addition, we'd like to let them edit their own accounts.
Users have the following properties:
-
Project editing
Logged-in users should be able to add a new project and edit an existing one for which they have admin privileges. This includes the ability to add and remove project members.
Projects have the following properties:
- Name
- Description
- Creation date
- Difficulty -- from one to ten
- Project status -- idea or active
- Support level -- a lot, some, or a little. If the project is created by a mentor, this is how much support they can provide. If the project is created by an apprentice, this is how much support they think they need.
- Links -- each link has a URL and an optional description
- Categories -- a project has one or more categories such as database, GUI, and so on.
- Members -- a project member is either a mentor or an apprentice. Any project member may be given project admin access.
-
Site administration
Site administrators should be able to edit any user or project. In addition, site admins can also edit the list of categories available for projects.
-
Security
A careful reader will notice that passwords are stored in the database in plain text form. This means that someone who hacks into the system where the data is stored won't have to do any extra work to get all the passwords.
In our opinion, this is OK for several reasons. Even if we stored hashed passwords, anyone sophisticated enough to be able to hack the operating system is going to be capable of running a dictionary attack against these passwords once they are retrieved from the database.
Furthermore, we like being able to send people their actual passwords via email when they request it, which is a choice we made in light of the fact that this is a relatively low security site. There is always a trade-off between security and convenience. But don't give us the same password you use for your bank account, OK?
Directory Layout
Because of the nature of Mason's autohandler feature,
directory layout is actually an important consideration when designing a site. Of course, you can always override a component's inheritance and inherit from any other component, but it makes sense to come up with a directory layout that minimizes the need to do this.
In the case of the Apprenticeship site, we only have one "skin" we want to apply to all components. This is done in the top-level autohandler. Our subdirectories are then used to implement access controls and dhandlers. Table 8-1 shows our directory layout.
Table 8-1. Apprentice site layoutFile Extensions
We decided to use several different extensions for our
components. Files ending in .html are top-level components processed by Mason, like /index.html. Files ending in .mas are called only by other components and are not accessible from a browser. In addition, we have a file ending in .css that is processed by Mason. This is our stylesheet.
The site has no images, so we don't need to worry about making sure they are served properly.
Apache Configuration
Our Apache configuration will assume that our document root and component root are the same directory, /home/apprentice/htdocs. This is the simplest solution and is appropriate for a single-purpose web server.
Our configuration in httpd.conf begins as follows:
PerlModule Apprentice
The Apprentice.pm module loads all the Perl modules used by this application, including various Apache::* modules, Digest::SHA1
, Time::Piece
, and others.
PerlSetVar MasonCompRoot /home/apprentice/htdocs PerlSetVar MasonDataDir /var/mason PerlSetVar MasonAllowGlobals $Schema PerlAddVar MasonAllowGlobals $User
These two objects will be used throughout almost all of the components of our
site. Rather than passing them as arguments to every component, which can
become extremely tedious, we will create them in our top-level autohandler and
limit their lifetime via the use of local().
PerlModule HTML::Mason::ApacheHandler
<Directory /home/apprentice/htdocs>
<LocationMatch "(\.html|\.css)$">
SetHandler perl-script
PerlHandler HTML::Mason::ApacheHandler
</LocationMatch>
</Directory>
As mentioned before, any file ending with .html or .css should be handled by Mason.
<LocationMatch "(\.mas|handler)$">
SetHandler perl-script
PerlModule Apache::Constants
PerlHandler "sub { return Apache::Constants::NOT_FOUND }"
</LocationMatch>
There's no reason to let anyone see our .mas components or our autohandlers and dhandlers, so in the interests of security
we block them out. We return a NOT FOUND status so that a curious script kiddie won't even know that these files
exist.
That's all we need in our Apache configuration to get this site up and running.
The Components
Now that the preliminaries are out of the way, it is time to look at the components that make up this site. We will not be looking at them in line-by-line detail, since this would be excruciatingly dull for all of us. In addition, since a number of components are conceptually similar to one another, we will not show the source for every component, instead saying something along the lines of "this one is mostly like that other one we looked at back there." But if you don't believe us, fear not, because this site's full source code is available at http://www.masonbook.com/.
It is worth noting that this site does not use all of Mason's features. Trying to create a site that did that would result in a monstrosity of biblical proportions (and that's big!). Instead, we created a clean, working site that is as elegantly designed as possible. We've tried to err on the side of brevity and pedagogy -- we could certainly add more features.
We have done our best to make the HTML in these components compliant with the latest HTML 4.01 Transitional Standard, with one major exception. This standard forbids the presence of forms embedded inside tables, but our design would have been grossly complicated by following this restriction, so we ignored it. Yes, we know this is wrong and bad and that we'll burn in web standards hell for this, but we are lazy and we don't care.
We did our best to keep the HTML in this site relatively simple. For text colors and fonts, we have a simple stylesheet. For layout, we have used the nested tables approach. This produces ugly HTML, but CSS positioning doesn't work with Netscape 4.x or other early browsers. In general, we will not be explaining the HTML portions of the components we examine, since we want to talk about programming with Mason, not how to make nice HTML.
One rule we did follow is that any table or portion of a table, such as a <tr> or <td> tag, must start and end in the same component, because it can be extremely
confusing when one component starts a table that another component finishes.
In addition, we have tried to make individual components self-contained whenever possible, so individual components often consist of one or more complete tables. Since tables can be embedded in other tables' cells, this makes it safe to call components from within a single table cell.
The Unrestricted Parts
A good place to start with the site is the index page and the other pages that are viewable by anybody without logging in.
Here are the components, in the order we'll discuss them:
Table 8-2.These components form the bulk of the site, with the remainder being those pieces intended for logged-in users and site administrators.
-
/syshandler
This is a component from which the top-level autohandler, /autohandler, inherits. Its job is to create a few objects that are used on almost every page. While some components don't inherit from the autohandler, they still inherit from this component in order to be able to use these objects. This is useful because some of our components don't need the look and feel wrapping provided by the top-level autohandler.
The component itself is fairly simple. In the
<%once>section, we create our schema object,$Schema, which is our point of entry for access to the database and therefore needed in almost every component. It is analogous to a DBI database handle, but at a higher level of abstraction. Since we need it everywhere and there is no point in re-creating it for each request, it is simply a global.The
$Userobject represents the currently logged-in user or a guest user. Since the API for these two types of users is the same, the components don't need to care about whether or not a user has logged in when using the$Userobject.The bit that deals with the cookie is simply checking to see if the user is who she claims to be, using a MAC (Message Authentication Code) generated by the SHA1 algorithm.
This is a fairly common authentication technique. When a user logs in, we use the
Digest::SHA1module to generate a unique string based on the user's user ID and a secret stored on the server (in our case the secret is a phrase). We then send the user a cookie containing this user ID and the generated MAC.When the user returns to the site, we simply regenerate the MAC based on the user ID that the cookie claims to represent. If the MAC matches what we would expect, we know that it is a valid cookie. If not, either the cookie got corrupted or someone is trying to trick us. This component only checks the cookie's value; it doesn't generate it. The cookie is generated in a different component that we will discuss later.
We place the call to the
row_by_pk()method in aneval{}block because the method will throw an exception if the row doesn't exist, and we want to ignore this failure. This technique is used throughout the site.Once we have some sort of user object, representing either a guest or a real user, we simply call the next component. In most cases, this will be the autohandler located at /autohandler.
We use the
inheritflag to explicitly turn off inheritance for this component in order to prevent an inheritance loop between this component and the /autohandler component.Although we promised not to spend too much time on Alzabo, we will point out that methods ending in
_treturn table objects, and that methods ending in_creturn column objects, just in case you were curious.<%once> $Schema = Apprentice::Data->schema; </%once> <%init> my %cookies = Apache::Cookie->fetch; # A "potential row" is an object that looks like something from the # database but that does not really exist. However, it has the # same interface so it is handy for things like a generic "guest" # user. my $guest = $Schema->User_t->potential_row( values => { username => 'Guest' } ); my $user; if ( exists $cookies{apprentice_user_login} ) { my %user_info = $cookies{apprentice_user_login}->value; if ( $user_info{user_id} && $user_info{MAC} ) { # This method of using a MAC to make sure a cookie is valid # is discussed in the Eagle Book. my $MAC = Digest::SHA1::sha1_hex ( $user_info{user_id}, $Apprentice::Secret ); # If the cookie's MAC matches the one we generate, we know # that the cookie has not been tampered with. if ( $user_info{MAC} eq $MAC ) { # This will be a _real_ row object, representing an # actual entry in the User table $user = eval { $Schema->User_t->row_by_pk ( pk => $user_info{user_id} ) }; } } } local $User = $user || $guest; $m->call_next; </%init> <%flags> inherit => undef </%flags> -
/autohandler
This component establishes the look of the site though most of the work is delegated to other components and methods. The call to
SELF:titleallows individual components to override or add to the basic title of "The Perl Apprenticeship Site," the default title.We start a basic table, stick a title banner on the top of the page, and make a few component calls. The first component called, /left_side_menu.mas , generates a menu down the left side of the page. This menu is part of every page.
The next component, /latest_projects.mas , lists the five most recently created projects. This is a nice way to show what's new on the site.
Finally, we invoke the
call_next()method of the request object to pass control onto the next component.The Screen shot of the index page in Figure 8-1 shows how this looks in practice.
Figure 8-1. Perl Apprentice site index pageThe parts handled by the autohandler are the title across the top that says "The Perl Apprenticeship Site," and everything down the left side. These portions of the page remain more or less the same on every page of the site. The pieces in the right two-thirds of the page are generated by the page specified by the client's request (see Figure 8-2). In this case, that part of the page was generated by the /index.html
component.
Figure 8-2. Perl Apprentice site divided into piecesAs noted before, this /autohandler component inherits from the /syshandler component.
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"> <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=utf-8"> <title><& SELF:title, %ARGS &></title> <link rel="stylesheet" href="<& /lib/url.mas, path => '/apprentice.css' &>" type="text/css"> </head> <body bgcolor="#FFFFFF"> <table width="100%" cellspacing="3" cellpadding="0"> <tr valign="middle"> <td colspan="3" bgcolor="#CCCCCC" align="center"> <h1 class="headline">The Perl Apprenticeship Site</h1> </td> </tr> <tr valign="top"> <td width="240"> <& left_side_menu.mas, %ARGS &> <& latest_projects.mas &> </td> <td> % $m->call_next; </td> </tr> </table> </body> </html> <%flags> inherit => '/syshandler' </%flags> <%method title> Perl Apprenticeship Site </%method> -
/apprentice.css
Mason doesn't have to be used just to generate HTML. This component generates a stylesheet for the site. It is dynamic because we want to have a smaller body font if the browser is Internet Explorer. Other than that, it is just standard text. This stylesheet is based in part on one created by Ask Bjørn Hansen for the perl.org sites, including http://dev.perl.org/ and http://jobs.perl.org/.
Setting the
inheritflag toundefensures that this component is not wrapped by any autohandler./* Netscape 4 doesn't inherit from the body class so we need to specify everything. */ body, table, td, p, span, ul { color: black; font-size: <% $font_size %>; font-family: serif } h1 { font-size: 16pt; font-weight: bold; font-family: sans-serif } h1.headline { color: #003366; line-height: 200%; font-size: 16pt; font-weight: bold; font-family: sans-serif } h2 { font-size: 13pt; font-weight: bold; font-family: sans-serif } h2.headline { color: #003399; line-height: 150%; font-size: 13pt; font-weight: bold; font-family: sans-serif } h3 { font-size: 12pt; font-weight: bold; font-family: sans-serif } td.heading { background-color: #AAAAAA } .error { color: #CC3333; font-size: 10pt } a:vlink { color: #690020 } a:active { color: #003600 } a:hover { color: #696040 } a:link { color: #900000 } <%init> $r->content_type('text/css'); # For some reason IE seems to make fonts look bigger. my $font_size = "10pt"; $font_size = "9pt" if $r->header_in("User-Agent") =~ m/MSIE/; </%init> <%flags> inherit => undef </%flags> -
/left_side_menu.mas
This component is longer than any of the previous ones, but not significantly more complicated. Several features are worth noting here.
The first is that the menu changes based on whether or not the return value from
$User->is_logged_in()is true. The$Userobject was generated in the /syshandler component and may represent either a guest user or a real logged-in user.If a user has logged in, she sees options that allow her to create a new project, edit any projects for which she may have editing access, change her user account information, and log out. The link to edit projects appears only if she actually has editing access to one or more projects.
Note that we construct all URLs using the /lib/url.mas component, which we will examine later. This component handles the construction of properly escaped URLs of arbitrary complexity. Using this component for all URLs would make it easy to add in something like URL-based sessions later on.
For the Logout URL, we are regenerating the URL, and query string, if any, for the current page. We do this because the component that handles logouts, /users/logout.html, will redirect the client back to the page where she clicked on the Logout link.
Getting back to the menu component, we can see that if the user is not logged in, we generate a form that POSTs to the /user/login_submit.html component. Again, we will be passing in the current URL and query string parameters to the login component so that it can send the user back where she came from, with either a cookie indicating a successful login or an error message. That error message is handled just above where the form starts, where we check the variable
$login_error.We take advantage of the fact that a POST request can also have a query string in order to put the
%caller_argshash into the query string, where we can be sure that keys and values will be received by the server in the right order. If we put the keys and values in the form itself as hidden fields, there is no guarantee that the browser will submit them in the order we specify.A bit further on, we see that if the
$User->is_admin()method returns true we add a few extra links for the site administrators.The
<%filter>section for this component shows a common application of filtering. We first determine the URL for our current page. Then, if there is a link in the menu that matches that page, we replace the anchor tag (<a>) with a bold tag (<b>).We need to special-case the URL /index.html because the link for this particular page is simply
<a href="/">. We do this with a regular expression so that it'll work properly if we decide to add links to other directories here in the future.<table width="100%" bgcolor="#CCCCCC" cellspacing="0" cellpadding="5"> <tr> <td colspan="2" align="center" class="heading"> <h2 class="headline">The site</h2> </td> </tr> </table> <table width="100%" bgcolor="#CCCCCC" cellspacing="0" cellpadding="1"> <tr> <td colspan="2">Welcome, <% $User->username %></td> </tr> <tr> <td colspan="2"><a href="<& /lib/url.mas, path => '/' &>">Home</a></td> </tr> <tr> <td colspan="2"> </td> </tr> <tr> <td colspan="2"><h3>Search</h3></td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/all_projects.html' &>">All the projects</a> </td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/browse.html' &>">Browse by category</a> </td> </tr> % if ( $User->is_logged_in ) { <tr> <td colspan="2"> </td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/logged_in/new_project.html' &>">Add a new project</a> </td> </tr> % if ( $User->has_projects ) { <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/logged_in/editable_project_list.html' &>"> Edit one of your projects</a> </td> </tr> % } % } <tr> <td colspan="2"> </td> </tr> % if ( $User->is_logged_in ) { <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/users/logout.html', query => { caller_url => $r->uri, caller_args => \%query_args }, &>">Logout</a></td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/logged_in/edit_self.html' &>">Edit your account</a> </td> </tr> % } elsif ( $r->uri !~ m,/login_form, ) { <tr> <td colspan="2"><h3>Login</h3></td> </tr> % if ($login_error) { <tr> <td colspan="2"><span class="error"><% $login_error | h %></td> </tr> % } <form action="<& /lib/url.mas, path => '/users/login_submit.html', query => { caller_url => $r->uri, caller_args => \%query_args } &>" method="POST"> <tr> <td>Username:</td> <td><input type="text" name="username"></td> </tr> <tr> <td>Password:</td> <td><input type="password" name="password"></td> </tr> <tr> <td colspan="2"><input type="submit" value="Submit"></td> </tr> </form> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/users/forgot_password.html' &>">Forgot my password</a> </td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/users/new_user.html' &>">New user</a> </td> </tr> % } % if ($User->is_admin) { <tr> <td colspan="2"> </td> </tr> <tr> <td colspan="2"><h3>Admin</h3></td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/admin/user_list.html' &>">Edit users</a> </td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/admin/edit_categories.html' &>">Edit categories</a> </td> </tr> % } <tr> <td colspan="2"> </td> </tr> <tr> <td colspan="2"> <a href="mailto:dave@perl.org">Complaints / Compliments?</a> </td> </tr> <tr> <td colspan="2"> </td> </tr> </table> <%args> $username => '' $login_error => '' </%args> <%init> my %query_args = $m->request_args; # These arguments are intended for use on this page and do not need # to be passed through to the login_submit.html component delete @query_args{ 'username', 'login_error' }; </%init> <%filter> (my $url = $r->uri) =~ s/index\.html$//; $url = $m->scomp( '/lib/url.mas', path => $url ); s{<a href="$url">([^<]+)</a>} {<b>$1</b>}; </%filter> -
/lib/url.mas
The purpose of this component is to construct a properly escaped and formatted query string based on the parameters it receives.
It would not be able to handle nested data structures or objects as values of the
%queryhash. For these, it would be necessary for us to use a session mechanism rather than trying to pass them around in the URL.3 Because the URI object'squery_form()method doesn't allow hash references, we convert any hash references we find in the%queryvalues to array references before passing%queryto thequery_form()method.While right now we are not taking advantage of most of the parameters this component allows us to pass, these were easy to implement and may come in handy in the future.
The backslash at the end of the last line is there to ensure that we don't accidentally add a new line to the URL.
<%args> $scheme => 'http' $username => undef $password => '' $host => undef $port => undef $path %query => ( ) $fragment => undef </%args> <%init> my $uri = URI->new; if ($host) { $uri->scheme($scheme); if (defined $username) { $uri->authority( "$username:$password" ); } $uri->host($host); $uri->port($port) if $port; } # Sometimes we may want to path in a query string # but the URI module will escape the question mark. my $q; if ( $path =~ s/\?(.*)$// ) { $q = $1; } $uri->path($path); # If there was a query string, we integrate it into the query # parameter. if ($q) { %query = ( %query, split /[&=]/, $q ); } # $uri->query_form doesn't handle hash ref values properly while ( my ( $key, $value ) = each %query ) { $query{$key} = ref $value eq 'HASH' ? [ %$value ] : $value; } $uri->query_form(%query) if %query; $uri->fragment($fragment) if $fragment; </%init> <% $uri->canonical | n %>\ -
/latest_projects.mas
With this component, we display the five most recently added projects. These projects are then displayed with their names and their creation dates. The date, which is returned from MySQL in the format of
'YYYY-MM-DD', is formatted via the /lib/format_date.mas component.This is the first time we have seen a project link. All project links are of the form /project/<project id number>.html. Obviously, we do not actually have files with names like /project/10012491.html. These URLs are intercepted by a dhandler instead. Underneath these links we show the total count of projects in the system.
Since we want this site to work properly from the moment it is made live, we also have to handle the case in which we have no projects in the system. Hopefully, this code path will not be followed for very long, but it is important.
<table width="100%" bgcolor="#CCCCCC" cellspacing="0" cellpadding="5"> <tr> <td colspan="2" align="center" class="heading"> <h2 class="headline">Latest projects</h2> </td> </tr> </table> <table width="100%" bgcolor="#CCCCCC" cellspacing="0" cellpadding="3"> % if ($count) { % while (my $project = $projects->next) { <tr> <td> <a href="<& /lib/url.mas, path => '/project/' . $project->project_id . '.html' &>"> <% $project->name | h %></a> </td> <td> <& /lib/format_date.mas, date => $project->creation_date, short => 1 &> </td> </tr> % } <tr> <td colspan="2"> </td> </tr> <tr> <td colspan="2"> <% $count %> project<% $count > 1 ? 's' : '' %> in the system. </td> </tr> % } else { <tr> <td colspan="2">No projects in the system.</td> </tr> % } </table> <%init> my $count = $Schema->Project_t->row_count; # This grabs a list of the five most recent projects, sorted first # by descending creation date, and then by name in ascending. my $projects = $Schema->Project_t->all_rows ( order_by => [ $Schema->Project_t->creation_date_c, 'desc', $Schema->Project_t->name_c, 'asc' ], limit => 5, ); </%init> -
/lib/format_date.mas
This simple component takes a date as returned by MySQL and turns it into a friendlier format. It can produce either a short ("Feb 4, 1970") or long ("February 04, 1970") date.
The particular formats used were chosen because they are understandable to (English-reading) users around the world. A purely numeric format such as "02/10/2002" can be ambiguous, depending on whether you are expecting the American or European ordering of the date components.
A smarter site might allow users to specify their preference as part of their account.
<%args> $date $short => 0 </%args> <%init> my $format; if ( $short ) { $format = '%b %d, %Y'; } else { $format = '%B %e, %Y'; } # remove time if it exists $date =~ s/ .*$//; </%init> <% Time::Piece->strptime( $date, '%Y-%m-%d' )->strftime($format)%>\ -
/index.html
Hey, there's nothing there!
Our index page simply calls a number of other components and provides almost nothing of its own. It does override the title method defined in the /autohandler component. The
<& PARENT:title &>method call will call the title method in the /autohandler component which, as we saw previously, simply produced the string"Perl Apprenticeship Site". After this we add" - Home"to identify the page.So now we should examine the components that actually make up our index page.
<& welcome.mas &> <& news.mas &> <& featured_project.mas &> <%method title> <& PARENT:title &> - Home </%method>
-
/welcome.mas
This component contains exactly one piece of code. In the course of our paragraph encouraging participation in the site, we want to offer context-appropriate links. Guest users should be encouraged to log in if they have an account or to create a new account. But a user who has already logged in should see links to create a new project.
This was something we did just because we could. It makes the site a little smarter and was easy to do with Mason.
<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading"> <h2 class="headline">Welcome to the Perl Apprenticeship Site</h2> </td> </tr> <tr> <td> <p> Way back at OSCON 2001, Adam Turoff (a.k.a. Ziggy) suggested that Perl needed a way to hook up people with lots of skill and experience, but little time, with people who had a desire to learn and free time, but not as much experience. In other words, we needed a Perl apprenticeship site. </p> <p> Meanwhile, Ken Williams and I had just started working on the <a href="http://www.masonbook.com/">Mason book</a> and we knew we wanted to have an example site as one of our chapters. We also knew we didn't want something like a web store. Boring! And useless too, since neither of us needed a web store. So when Ziggy announced his idea, Ken suggested that we implement it for the book. It helps us because it gives us something to fill Chapter 8, and it helps the Perl community too. Perfect! </p> <p> So that's our story. Now it's your turn. If you're someone who has a neat project idea and not enough time to finish, but you think you could guide a few 'apprentices', then % if ($User->is_logged_in) { <a href="<& /lib/url.mas, path => '/logged_in/new_project.html' &>"> post your project idea</a>. If you're someone with an idea but you need some guidance, then you too can <a href="<& /lib/url.mas, path => '/logged_in/new_project.html' &>"> post a project</a> and look for a mentor. % } else { log in over in the left menu or <a href="<& /lib/url.mas, path => '/users/new_user.html' &>">create a new account</a> % } </p> <p> If you don't have an idea but you have some free time and a desire to learn, then <a href="<& /lib/url.mas, path => '/browse.html' &>"> browse</a> the project listings and see if there's something that interests you. </p> <p> - Dave Rolsky </p> </td> </tr> </table> -
/news.mas
New features of the site will be displayed with this component simply by editing its text.
We get the last modified time for the component by calling
stat()on the component file. We figure that the only time this component will be changed is when there is new news. For now, the whole site is new, so there is not much news other than that.<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading"><h2 class="headline">What's New?</h2></td> </tr> <tr> <td> <p> The whole site, at this point. </p> <p> <em>Last modified: <% $last_mod %></em> </p> </td> </tr> </table> <%init> my $comp_time = (stat $m->current_comp->source_file)[9]; my $last_mod = Time::Piece->strptime( $comp_time, '%s' )->strftime( '%B %e, %Y %H:%M' ); </%init> -
/featured_project.mas
This component is something that can be used to feature a particular project if one catches the eye of the site admins. An admin can simply edit the value of the
$project_idvariable in the<%init>section. If this value is set to zero orundef, the component will simply return before generating any text, which gives us a way to not feature any project at all.We could have stored information on the featured project in the database, and in the future we may go that route. But for now we decided to keep it simple and just assume that this task can be done by someone with access to component files on the web server.
Of course, this particular method of storing the featured project would not scale well if the site were served by multiple web servers.
It is also worth noting that we can easily feature more than one project. Imagine that the
<%init>section started thusly:my @ids = (1, 3, 129, 440); my $project_id = $ids[ rand @ids ];
Now each time the page is generated, one of the four project IDs in the
@idsvariable will be chosen as the featured project. Simple.<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading" colspan="2"> <h2 class="headline">Featured Project</h2> </td> </tr> <tr> <td> <h2><a href="<& /lib/url.mas, path => "/project/$project_id.html" &>"> <% $project->name | h %></a></h2> </td> <td>Created: <& /lib/format_date.mas, date => $project->creation_date &></td> </tr> <tr> <td><b>Categor<% @categories > 1 ? 'ies' : 'y' %>:</b></td> <td><% join ', ', @categories %></td> </tr> <tr> <td colspan="2"><h3>Members</h3></td> </tr> % while ( my $user = $members->next ) { <tr> <td> <a href="<& /lib/url.mas, path => '/user.html', query => { user_id => $user->user_id } &>"> <% $user->username | h %></a> </td> <td> % if ($project->user_is_admin($user)) { <b>Admin</b> % } else { % } </td> </tr> % } <tr> <td colspan="2"> <% HTML::FromText::text2html ( $project->description, paras => 1 ) %> </td> </tr> <tr> <td colspan="2"> <p> Sure, it might be a dummy project but we think it is pretty cool stuff. Help out! </p> </td> </tr> </table> <%init> my $project_id = 1; return unless $project_id; my $project = eval { $Schema->Project_t->row_by_pk( pk => $project_id ) } || return; # This grabs all of the project's members, ordered by their admin # status and then their username. my $members = $Schema->join( select => $Schema->User_t, join => [ $Schema->tables( 'ProjectMember', 'User' ) ], where => [ $Schema->ProjectMember_t->project_id_c, '=', $project_id ], order_by => [ $Schema->ProjectMember_t->is_project_admin_c, 'desc', $Schema->User_t->username_c, 'asc' ] ); my @categories = map { $_->name } $project->Categories( order_by => $Schema->Category_t->name_c )->all_rows; </%init>We used the handy
HTML::FromTextmodule (available on CPAN) to take the text description of the project and turn it into HTML. We tell it that the text is "paragraph-oriented" via theparas => 1parameter so that it will turn line breaks into the proper HTML tags. -
/all_projects.html
This component actually delegates most of its work to the /search_results.mas component. All this component does is create a cursor representing the rows of interest for this query. In this case, the query is simply
'all projects'. We take advantage of the limit and offset features of MySQL in order to select only those rows we are interested in. As we shall see in a moment, the /search_results.mas component displays paged results, 20 per page.In addition, this component needs to get a count of how many rows this query would get without the limit. It also creates a textual description of the search it is doing so that this can be displayed to the user.
The
$startand$limitarguments are part of the r esults paging system, and any component that implements a search query must accept them in order for the paging system to work.<& search_results.mas, count => $count, projects => $projects, summary => $summary, start => $start, limit => $limit, %ARGS &> <%args> $start => 0 $limit => 20 </%args> <%init> my $summary = 'all projects'; my $count = $Schema->Project_t->row_count; my $projects = $Schema->Project_t->all_rows ( order_by => [ $Schema->Project_t->creation_date_c, 'desc', $Schema->Project_t->name_c, 'asc' ], limit => [ $limit, $start ], ); </%init> <%method title> <& PARENT:title &> - All projects </%method> -
/search_results.mas
This is where the actual work of displaying results is done. This component is currently used by just two other components, but it is designed so that if we add more search options, such as a keyword search, it can handle those as well.
This component takes the
$summaryand$countarguments and uses them to tell the user what kind of search he just did (in case he forgot) and how many results there were in total.If there are more results than can be shown on one page, it calls the /lib/paging_controls.mas component to do the work of generating links to all the other pages of results.
Finally, if there were results, it loops through the cursor and displays information about each project in turn.
<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading" colspan="4"> <h2 class="headline">Search Results</h2> </td> </tr> <tr> <td colspan="4"> You searched for <% $summary | h %>. There <% $count == 1 ? 'is' : 'are' %> <% $count %> result<% $count != 1 ? 's' : '' %>. </td> </tr> % if ($count > $limit) { <tr> <td colspan="4"> <& /lib/paging_controls.mas, %ARGS &> </td> </tr> % } % if ($count) { <tr> <td width="40%"><b>Name</b></td> <td width="30%"><b>Created on</b></td> <td width="15%"><b>Difficulty</b></td> <td width="15%"><b>Project status</b></td> </tr> % while (my $project = $projects->next) { <tr> <td> <a href="<& /lib/url.mas, path => '/project/' . $project->project_id . '.html' &>"> <% $project->name | h %></a> </td> <td><& /lib/format_date.mas, date => $project->creation_date &></td> <td><% $project->difficulty %></td> <td><% $project->status %></td> </tr> % } % } </table> <%args> $count $projects $summary $start $limit </%args> -
/lib/paging_controls.mas
Generating paged search results is a common need in web applications. If you have a database of hundreds, thousands, or more searchable items, you need a way to handle large result sets. The usual way to do this is to break the results into multiple pages, showing a certain number per page with links to other pages.
This component generates the links to the others pages, which look something like this:
<< 1 2 3 4 5 6 7 8 >>
The "<<" link moves one page back while the ">>" link moves one page forward. The page the user is currently viewing is marked with bold text instead of being a link. If the user is on the first or last page, the previous or next page links are not shown.
This is all fine until you have something like 100 pages. At that point you need another level of navigation, so we will end up with something like this:
... << 21 22 23 24 25 26 27 28 29 30 >> ...
The first "..." link will move back to the last page of the previous group of 10, in this case page 20. The end "..." link will move to the beginning of the next group of 10, in this case, page 31.
This design is capable of handling a large number of pages gracefully, although if you anticipated that you would often be generating result sets consisting of thousands of items, you might want to add additional navigation links that allowed the user to jump forward and backward in larger chunks.
One interesting aspect of this component is how it generates its links. Instead of requiring that a URL be passed in to the component, we use the Apache request object's
uri()method to determine the current URL. To find out what arguments were passed to the page, we use the$m->request_args()method. We do this because we just want to reproduce the arguments passed in by the client, not any generated by component calls earlier in the call stack. We delete thelimitandstartarguments since we will be overriding them for each link.<table width="100%"> <tr> <td>Displaying results <% $start + 1 %> - <% $last_shown %>.</td> </tr> </table> <table width="100%"> <tr> <td width="7%"> % if ( $previous_tenth >= 10 ) { <a href="<& /lib/url.mas, path => $r->uri, query => { start => ($previous_tenth - 1) * $limit, limit => $limit, %query } &>">...</a> % } else { % } </td> <td width="7%"> % if ( $current_page > 1 ) { <a href="<& /lib/url.mas, path => $r->uri, query => { start => $start - $limit, limit => $limit, %query } &>"><<</a> % } </td> % foreach my $page ( ($previous_tenth + 1)..($next_tenth - 1) ) { % if ( $page <= $total_pages ) { <td width="7%"> % if ( $page != $current_page ) { <a href="<& /lib/url.mas, path => $r->uri, query => { start => ($page - 1) * $limit, limit => $limit, %query } &>"><% $page %></a> % } else { <b><% $page %></b> % } % } else { % } % } </td> <td width="7%"> % if ( $current_page < $total_pages ) { <a href="<& /lib/url.mas, path => $r->uri, query => { start => $start + $limit, limit => $limit, %query } &>">>></a> % } else { % } </td> <td width="7%"> % if ( $next_tenth <= $total_pages ) { <a href="<& /lib/url.mas, path => $r->uri, query => { start => ($next_tenth - 1) * $limit, limit => $limit, %query } &>">...</a> % } else { % } </td> </tr> </table> <%args> $start $limit $count </%args> <%init> my %query = $m->request_args; delete @query{ 'start', 'limit' }; my $total_pages = int( $count / $limit ); $total_pages++ if $count % $limit; my $current_page = ( $start / $limit ) + 1; my $previous_tenth = $current_page - ( $current_page % $limit ? $current_page % $limit : $limit ); my $next_tenth = $previous_tenth + 11; my $last_shown = $start + $limit > $count ? $count : $start + $limit; </%init> -
/browse.html
This page simply iterates through all the different project categories. If a category has projects, then we generate a link to browse that category.
<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading"><h2 class="headline">Browse by Category</h2></td> </tr> % while (my $category = $categories->next) { <tr> <td> % if (my $count = $category->project_count) { <a href="<& /lib/url.mas, path => 'show_category.html', query => { category_id => $category->category_id } &>"> <% $category->name | h %></a> (<% $count %> project<% $count > 1 ? 's' : '' %>) % } else { <% $category->name | h %> (No projects) % } </td> </tr> % } </table> <%init> my $categories = $Schema->Category_t->all_rows( order_by => $Schema->Category_t->name_c ); </%init> <%method title> <& PARENT:title &> - Browse by category </%method> -
/show_category.html
This is what /browse.html links to for each category. This code is quite similar to what we saw in /all_projects.html and uses the same component, /search_results.mas, to do all the real work.
One feature new to this component is that the title method dynamically adds the category name to the page title. We used a
<%shared>section here in order to avoid creating the same category object twice. If the category ID we are given is invalid, then we simply redirect the user back to the home page. It's lazy but it's better than simply showing an error message.<& search_results.mas, count => $count, projects => $projects, summary => $summary, start => $start, limit => $limit, %ARGS &> <%shared> my $category = eval { $Schema->Category_t->row_by_pk ( pk => $m->request_args->{category_id} ) } || $m->comp( '/lib/redirect.mas', path => '/' ); </%shared> <%args> $start => 0 $limit => 20 $category_id </%args> <%init> my $summary = 'projects in the "' . $category->name . '" category'; my $count = $category->project_count; my $projects = $Schema->join( select => $Schema->Project_t, join => [ $Schema->tables( 'Project', 'ProjectCategory' ) ], where => [ $Schema->ProjectCategory_t->category_id_c, '=', $category_id ], order_by => [ $Schema->Project_t->creation_date_c, 'desc', $Schema->Project_t->name_c, 'asc' ], limit => [ $limit, $start ], ); </%init> <%method title> <& PARENT:title &> - <% $category->name | h %> projects </%method> -
/user.html
This is our user info display component. There's not much here that we haven't seen before. Make some objects, display some information from the objects. Been there, done that.
Note that this isn't actually duplicating code from other components, though. It's just similar to them.
-
/project/dhandler
This component is quite similar to the /user.html component but instead of being called with a query string, is called with a URL like /project/77.html, where 77 is the project ID. Using a dhandler here was an arbitrary choice, but it lets us have nice, search-engine-friendly URLs.
<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading" colspan="2"> <h2 class="headline"><% $project->name | h %></h2> </td> </tr> <tr> <td colspan="2"> Created: <& /lib/format_date.mas, date => $project->creation_date &> </td> </tr> <tr> <td colspan="2"> <% HTML::FromText::text2html ( $project->description, paras => 1 ) %> </td> </tr> <tr> <td><b>Categor<% @categories > 1 ? 'ies' : 'y' %>:</b></td> <td><% join ', ', @categories %></td> </tr> <tr> <td><b>Project status:</b></td> <td><% $project->status | h %></td> </tr> <tr> <td><b>Support level:</b></td> <td><% $project->support_level | h %></td> </tr> <tr> <td colspan="2"><h3>Members</h3></td> </tr> % while (my $user = $members->next) { <tr> <td> <a href="<& /lib/url.mas, path => '/user.html', query => { user_id => $user->user_id } &>"> <% $user->username | h %></a> </td> <td> % if ($project->user_is_admin($user)) { <b>Admin</b> % } else { % } </td> </tr> % } % if ( $Schema->ProjectLink_t->row_count % ( where => [ $Schema->ProjectLink_t->project_id_c, '=', $project_id ] ) ) { <tr> <td colspan="2"> </td> </tr> <tr> <td colspan="2"><h3>Links</h3></td> </tr> % while (my $link = $links->next) { <tr> <td colspan="2"> <a href="<% $link->url %>"><% $link->description | h %></a> </td> </tr> % } % } % if ($User->is_admin || $User->is_project_admin($project)) { <tr> <td colspan="2"> </td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/logged_in/edit_project.html', query => { project_id => $project->project_id } &>"> Edit this project</a> </td> </tr> % } </table> <%shared> my ($project_id) = $m->dhandler_arg =~ /(\d+).html/; my $project = eval { $Schema->Project_t->row_by_pk( pk => $project_id ) } || $m->comp( '/lib/redirect.mas', path => '/' ); </%shared> <%init> my $links = $project->Links( order_by => $Schema->ProjectLink_t->url_c ); my $members = $Schema->join( select => $Schema->User_t, join => [ $Schema->tables( 'ProjectMember', 'User' ) ], where => [ $Schema->ProjectMember_t->project_id_c, '=', $project_id ], order_by => [ $Schema->ProjectMember_t->is_project_admin_c, 'desc', $Schema->User_t->username_c, 'asc' ] ); my @categories = map { $_->name } $project->Categories( order_by => $Schema->Category_t->name_c )->all_rows; </%init> <%method title> <& PARENT:title &> - <% $project->name | h %> </%method> -
/login_form.html
This is a simple login form that forwards various parameters it receives, like
$success_urland%success_args, to the /users/login_submit.html component.<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading" colspan="2"><h2 class="headline">Login</h2></td> </tr> % if ($message) { <tr> <td colspan="2"><% $message | h %></td> </tr> % } % if ($login_error) { <tr> <td colspan="2"><% $login_error | h %></td> </tr> % } <form action="<& /lib/url.mas, path => '/users/login_submit.html', query => { caller_url => $r->uri, success_url => $success_url, success_args => \%success_args } &>" method="POST"> <tr> <td>Username:</td> <td><input type="text" name="username" value="<% $username | h %>"></td> </tr> <tr> <td>Password:</td> <td><input type="password" name="password"></td> </tr> <tr> <td colspan="2"><input type="submit" value="Submit"></td> </tr> </form> </table> <%args> $message => undef $login_error => undef $success_url => '/' %success_args => ( ) $username => '' </%args> <%method title> <& PARENT:title &> - Login </%method> -
/users/new_user.html
This component delegates most of its work to the /users/user_form.mas component, which will do the actual work of generating the form.
The
$new_userobject represents a "potential" database row, which is an object that has the same API as a real user object. However, a potential row does not correspond to any actual data in the database. This simplifies creating the /users/user_form.mas component, as that component can simply use the row object API whether we are creating a new user or editing an existing one.The
$available_statusobject represents the row from the UserStatus table where the status is'Available'. We fetch this rather than hard-coding that column's id value.<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading" colspan="2"><h2 class="headline">New User</h2></td> </tr> <& user_form.mas, submit_to => 'new_user_submit.html', user => $new_user, %ARGS &> </table> <%init> my $available_status = $Schema->UserStatus_t->one_row ( where => [ $Schema->UserStatus_t->column('status'), '=', 'Available' ] ); my $new_user = $Schema->User_t->potential_row ( values => { username => '', password => '', real_name => '', email_address => '', user_status_id => $available_status->user_status_id, } ); </%init> <%method title> <& PARENT:title &> - New user </%method> -
/users/user_form.mas
This form is used for both creating new users and editing existing ones. To prepopulate the form fields, it first looks at the
%ARGShash. If there are values for these fields here, it assumes that these have priority because the only way for%ARGSto have such values is if the form was submitted but then rejected for a data validation error, in which case the browser is redirected back to the submitting page. When that happens, we want to show the user the rejected values that were just entered into the form. If there is nothing in%ARGS, then we look at the$userobject for these values.Unless the user for whom this page is being generated is an admin user, we don't bother showing the checkbox that allows them to turn on the admin flag for a user since that checkbox is respected only when a site administrator submits the form.
The
$submit_tovariable is used to set the form's action attribute. This allows us to use this form for both creating new users and editing existing ones.The
$return_tovalue is simply passed through the form to the component that handles the form submission, which will use it to determine where to send the browser if the form submission is successful.% foreach my $err (@errors) { <tr> <td colspan="2"><span class="error"><% $err | h %></td> </tr> % } <form action="<& /lib/url.mas, path => $submit_to &>" method="POST"> <input type="hidden" name="return_to" value="<% $return_to %>"> % if ($user->user_id) { <input type="hidden" name="user_id" value="<% $user->user_id %>"> % } <tr> <td>Username:</td> <td> <input type="text" name="username" value="<% $form_vals{username} | h %>" size="20" maxlength="30"> </td> </tr> <tr> <td>Password:</td> <td> <input type="password" name="password" value="<% $form_vals{password} | h %>" size="20" maxlength="100"> </td> </tr> <tr> <td>Confirm password:</td> <td> <input type="password" name="password2" value="<% $form_vals{password2} | h %>" size="20" maxlength="100"> </td> </tr> <tr> <td>Real name:</td> <td> <input type="text" name="real_name" value="<% $form_vals{real_name} %>" size="20" maxlength="75"> </td> </tr> <tr> <td>Email address:</td> <td> <input type="text" name="email_address" value="<% $form_vals{email_address} %>" size="20" maxlength="150"> </td> </tr> <tr> <td>How available are you?</td> <td> <select name="user_status_id"> % while (my $status = $user_statuses->next) { <option value="<% $status->user_status_id %>" <% $form_vals{user_status_id} == $status->user_status_id ? 'selected="selected"' : ''%>> <% $status->status | h %> </option> % } </select> </td> </tr> % if ($User->is_admin) { <tr> <td>Site admin:</td> <td> <input type="checkbox" name="is_admin" value="1" <% $form_vals{is_admin} ? 'checked="checked"': '' %>> </td> </tr> % } <tr> <td colspan="2"><input type="submit" value="Submit"></td> </tr> <form> <%args> $submit_to $return_to => '/' $user @errors => ( ) </%args> <%init> my $user_statuses = $Schema->UserStatus_t->all_rows ( order_by => $Schema->UserStatus_t->status_c ); my %form_vals; foreach my $field ( qw( username password real_name email_address user_status_id is_admin ) ) { $form_vals{$field} = exists $ARGS{$field} ? $ARGS{$field} : $user->$field( ); } $ form_vals{password2} = exists $ARGS{password2} ? $ARGS{password2} : exists $ARGS{password} ? $ARGS{password} : $user->password; </%init> -
/users/new_user_submit.html
Because data validation is handled by our module code, this component doesn't have much to do. If the insert succeeds, we set the cookie used to indicate a successful login and redirect the client to whatever path is in the
$return_tovariable.Note that we will never set the
is_adminflag to true unless the submitting user is a site administrator.One style point: this component calls a few other components, but it uses
$m->comp()instead of<& &>tags to do so. This is partly just because it was convenient to call the components from within the<%init>section, but it also emphasizes the fact that those particular components don't generate any HTML output.<%args> $return_to </%args> <%init> # When inserting a new row, data validation checks are performed and an # exception is thrown if any of the checks fail. my $user = eval { $Schema->User_t->insert ( values => { ( map { $_ => $ARGS{$_} } qw( username password password2 real_name email_address user_status_id ) ), is_admin => $User->is_admin ? $ARGS{is_admin} : 0, } ); }; # One or more data validation checks failed $m->comp( '/lib/redirect.mas', path => 'new_user.html', query => { %ARGS, errors => $@->errors } ) if $@ && UNIVERSAL::isa( $@, 'Apprentice::Exception::DataValidation' ); # Some other unforeseen error happened die $@ if $@; $m->comp( '/lib/set_login_cookie.mas', user => $user ); $m->comp( '/lib/redirect.mas', path => $return_to ); </%init> <%flags> inherit => '/syshandler' </%flags> -
/lib/redirect.mas
With Mason's built-in
redirect()method, this component is trivially simple. We use thescomp()method to get a URL in the form of a string from the /lib/url.mas component, then pass that to theredirect()method, which will generate the proper headers and send them to the client.<%init> my $url = $m->scomp( '/lib/url.mas', %ARGS ); $m->redirect($url); </%init>
-
/users/login_submit.html
This component is the target for the login form we saw back in /left_side_menu.mas, as well as /login_form.html page.
We check the given username to make sure it exists and that the password given matches the password in the database. If this is not the case, we simply redirect the user back to the calling page with an error.
Otherwise, we set the cookie that marks a successful login and issue a redirect to the URL specified in
$success_url.This is a common pattern in web applications. You have a URL that handles form submissions that needs to redirect the browser to a different page, so you make the submission-receiving component capable of taking a parameter indicating where to redirect the client.
<%args> $username $password $caller_url %caller_args => ( ) $success_url => undef %success_args => ( ) </%args> <%init> my $user = $Schema->User_t->one_row ( where => [ $Schema->User_t->username_c, '=', $username ] ); unless ( $user && $password eq $user->password ) { $m->comp( '/lib/redirect.mas', path => $caller_url, query => { caller_args => \%caller_args, username => $username, login_error => 'Invalid login.' }, ); } $m->comp( '/lib/set_login_cookie.mas', user => $user ); # By default, we just send them back to the calling page. $success_url = $caller_url unless defined $success_url && length $success_url; %success_args = %caller_args unless %success_args; $m->comp( '/lib/redirect.mas', path => $success_url, query => \%success_args ); </%init> <%flags> inherit => '/syshandler' </%flags> -
/lib/set_login_cookie.mas
We discussed using a MAC for authentication in our explanation of the /syshandler component. This is the flip side of that process. Here we simply set a cookie containing the user's user ID and a MAC based on that user ID.
A component that affects the headers sent to the client, such as this one, must be called before headers are sent. Since this site runs with autoflushing turned off, this is not a problem, because headers won't be sent until after all the content is generated.
<%args> $user </%args> <%init> Apache::Cookie->new ( $r, -name => 'apprentice_user_login', -value => { user_id => $user->user_id, MAC => Digest::SHA1::sha1_hex ( $user->user_id, $Apprentice::Secret ) }, -path => '/', -domain => 'apprentice.perl.org', -expires => '+1M', )->bake; </%init> -
/users/logout.html
Here we remove the login cookie set by the /lib/set_login_cookie.mas component by setting a cookie with an expiration date in the past, which removes the cookie from the browser.
<%args> $caller_url %caller_args => ( ) </%args> <%init> Apache::Cookie->new ( $r, -name => 'apprentice_user_login', -value => '', -path => '/', -domain => 'apprentice.perl.org', -expires => '-1d', )->bake; $m->comp( '/lib/redirect.mas', path => $caller_url, query => \%caller_args ); </%init> <%flags> inherit => '/syshandler' </%flags> -
/users/forgot_password.html
This is a simple form for users who forgot their password. A user enters her username, and the system sends her an email.
-
/users/forgot_password_submit.html
This component does the actual sending of email for forgotten passwords. Assuming that there is a username matching that entered by the user, we generate a simple email telling her her password.
We use the
$r->register_cleanup()method to delay sending email until after output has been sent to the client. This technique is useful for any sort of operation that might take a long time, but the downside is that if the callback fails, there is no easy way to communicate this to the user. If this is a problem, you will simply have to do this while the client waits for output.The
$r->register_cleanup()method is documented in the Apache module documentation as well as the books mentioned in the beginning of Chapter 7.<%args> $username </%args> <%init> my $user = $Schema->User_t->one_row ( where => [ $Schema->User_t->username_c, '=', $username ] ); unless ( $user ) { $m->comp( '/lib/redirect.mas', path => 'forgot_password.html', query => { error => 'Invalid username.' } ); } my $body = "Your password is:\n\n" . $user->password . "\n\nwebmaster\@apprentice.perl.org"; $r->register_cleanup ( sub { Apprentice::send_email ( to => $user->email_address, from => 'webmaster@apprentice.perl.org', subject => 'Your password for apprentice.perl.org', body => $body ) } ); $m->comp( '/lib/redirect.mas', path => '/index.html', query => { login_error => 'Your password has been mailed to you.' } ); </%init> <%flags> inherit => '/syshandler' </%flags>
Components with Access Controls
The components we just looked at are available to anybody who comes to the site, with no login required. The rest of the components are divided into two directories: one for logged-in users and the other for site administrators. We will start with the components available for logged-in users only. They are:
-
/logged_in/autohandler
-
/lib/check_access_level.mas
-
/logged_in/edit_self.html
-
/logged_in/edit_user_submit.html
-
/logged_in/new_project.html
-
/logged_in/project_form.mas
-
/logged_in/new_project_submit.html
-
/logged_in/editable_project_list.html
-
/logged_in/edit_project.html
-
/logged_in/check_access_to_project.mas
-
/logged_in/edit_project_submit.html
-
/logged_in/edit_members.html
-
/logged_in/add_project_member.html
-
/logged_in/remove_project_member.html
-
/logged_in/delete_project.html
These components are all about editing things on the site. Let's take a look.
-
/logged_in/autohandler
All this component does is implement access checking for the directory. If you are not a logged-in user, you cannot look at any components in this directory.
<%init> $m->comp( '/lib/check_access_level.mas', level => 'is_logged_in' ); $m->call_next; </%init>
-
/lib/check_access_level.mas
This component simply redirects the user to the login form if he does not meet the access-level requirement. If the user logs in successfully, he'll be redirected back to the component he was originally prevented from accessing.
<%args> $level </%args> <%init> my $requested_url = $r->uri; my %query_args = $m->request_args; my $level_description = $level eq 'is_logged_in' ? 'a logged-in' : 'an admin'; $m->comp( '/lib/redirect.mas', path => '/login_form.html', query => { message => "This area requires $level_description user.", success_url => $requested_url, success_args => \%query_args, } ) unless $User->$level( ); </%init> -
/logged_in/edit_self.html
Editing a user simply uses the handy /users/user_form.mas component we saw previously, this time with a different action attribute for the form, set via the
submit_toparameter. It doesn't get any easier than that.<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading" colspan="2"> <h2 class="headline">Edit Your Account</h2> </td> </tr> <& /users/user_form.mas, submit_to => 'edit_user_submit.html', return_to => $r->uri, user => $User, %ARGS &> </table> <%method title> <& PARENT:title &> - Edit your account </%method> -
/logged_in/edit_user_submit.html
This component implements an additional access check. We want to make sure that the user submitting this form is either a site administrator or the owner of the account being edited. Otherwise, we simply send her away.
As with creating a new user, we always set the
is_adminflag to a false value unless the submitting user is a site administrator.<%args> $user_id $return_to </%args> <%init> $m->comp( '/lib/redirect.mas', path => '/' ) unless $User->is_admin or $User->user_id == $user_id; my $user = eval { $Schema->User_t->row_by_pk( pk => $user_id ) } || $m->comp( '/lib/redirect.mas', path => '/' ); eval { $user->update( ( map { $_ => $ARGS{$_} } qw( username password password2 real_name email_address user_status_id ) ), is_admin => $User->is_admin ? $ARGS{is_admin} : 0, ); }; $m->comp( '/lib/redirect.mas', path => $return_to, query => { %ARGS, errors => $@->errors } ) if $@ && UNIVERSAL::isa( $@, 'Apprentice::Exception::DataValidation' ); die $@ if $@; $m->comp( '/lib/redirect.mas', path => $return_to ); </%init> <%flags> inherit => '/syshandler' </%flags> -
/logged_in/new_project.html
The project creation and editing pages are very similar to the pages for creating and adding users. In both cases, we were able to take advantage of Mason's component system to achieve a high level of reuse.
-
/logged_in/project_form.mas
This page is closely analogous to /users/user_form.mas. Once again, we need to handle prepopulating the form with existing values when editing projects or with defaults for new projects. We also need to take into account that we may have come here as the result of an error in data validation, in which case we want to preserve the values submitted by the user.
Once again, we take a
$submit_toparameter to set the form's action attribute, just as with the user form component.This component has more code simply because projects are more complicated than users. Projects can have multiple categorizations, zero or more links each with an optional description, and so on.
The manner in which links are handled is interesting. We need a way to distinguish between editing or deleting an existing link and adding a new one. We do this by giving the form fields different names. For existing links, the fields contain the link IDs, which we also store separately so that we can iterate over them in the /logged_in/edit_project_submit.html component, discussed later.
% foreach my $err (@errors) { <tr valign="top"> <td colspan="2"><span class="error"><% $err | h %></td> </tr> % } <form action="<& /lib/url.mas, path => $submit_to &>" method="POST"> % if ($project->project_id) { <input type="hidden" name="project_id" value="<% $project->project_id %>"> % } <tr valign="top"> <td>Name:</td> <td> <input type="text" name="name" value="<% $form_vals{name} | h %>" size="20" maxlength="30"> </td> </tr> <tr valign="top"> <td>Description:</td> <td> <textarea name="description" rows="5" cols="40">\ <% $form_vals{description} | h %>\ </textarea> </td> </tr> <tr valign="top"> <td>Categories<br>(1 or more):</td> <td> <select name="category_ids" multiple="1" size="4"> % while (my $category = $categories->next) { <option value="<% $category->category_id %>" <% $current_categories{ $category->category_id } ? 'selected="selected"' : '' %>> <% $category->name | h %> </option> % } </select> </td> </tr> <tr valign="top"> <td>Difficulty:</td> <td> <select name="difficulty"> % foreach (1..10) { <option value="<% $_ %>" <% $form_vals{difficulty} == $_ ? 'selected="selected"' : '' %>> <% $_ %> </option> % } </select> </td> </tr> <tr valign="top"> <td>Status:</td> <td> <select name="project_status_id"> % while (my $status = $statuses->next) { <option value="<% $status->project_status_id %>" <% $status->project_status_id == $form_vals{project_status_id} ? 'selected="selected"' : '' %>> <% $status->status %> </option> % } </select> </td> </tr> % unless ($member_count) { <tr valign="top"> <td> My role will be:</td> <td> <select name="role_id"> % while (my $role = $roles->next) { <option value="<% $role->role_id %>" <% $form_vals{role_id} == $role->role_id ? 'selected="selected"': '' %>> <% $role->role | h %> </option> % } </td> </tr> % } <tr valign="top"> <td colspan="2"> <p> If you chose the 'Mentor' role, then this is the support level you will provide. If you chose the 'Apprentice' role, then this is the support level you think you require. </p> </td> </tr> <tr valign="top"> <td>Support level:</td> <td> <select name="project_support_level_id"> % while (my $level = $support_levels->next) { <option value="<% $level->project_support_level_id %>" <% $level->project_support_level_id == $form_vals{project_support_level_id} ? 'selected="selected"' : '' %>> <% $level->support_level %> </option> % } </select> </td> </tr> <tr valign="top"> <td colspan="2"> <table width="100%" cellpadding="0"> <tr valign="top"> <td colspan="2"><h3>Links</h3></td> </tr> <tr valign="top"> <td>URL</td> <td>Description</td> </tr> % foreach my $link (@links) { <input type="hidden" name="project_link_ids" value="<% $link->{id} %>"> % next unless defined $link->{url}; <tr valign="top"> <td> <input type="text" name="url<% $link->{id} %>" value="<% $link->{url} | h %>" size="30" maxlength="200"> </td> <td> <input type="text" name="description<% $link->{id} %>" value="<% $link->{description} | h %>" size="50" maxlength="200"> </td> </tr> % } % foreach (1..2) { <tr valign="top"> <td> <input type="text" name="new_url<% $_ %>" value="<% $ARGS{"new_url$_"} || '' | h %>" size="30" maxlength="200"> </td> <td> <input type="text" name="new_description<% $_ %>" value="<% $ARGS{"new_description$_"} || '' | h %>" size="50" maxlength="200"> </td> </tr> % } </table> </td> </tr> <tr valign="top"> <td colspan="2"><input type="submit" value="Submit"></td> </tr> <form> <%args> $submit_to $project @category_ids => ( ) @errors => ( ) </%args> <%init> my $statuses = $Schema->ProjectStatus_t->all_rows ( order_by => $Schema->ProjectStatus_t->status_c ); my $support_levels = $Schema->ProjectSupportLevel_t->all_rows ( order_by => $Schema->ProjectSupportLevel_t->project_support_level_id_c ); my $categories = $Schema->Category_t->all_rows ( order_by => $Schema->Category_t->name_c ); my $links = $project->Links; my @links; while (my $link = $links->next) { my $id = $link->project_link_id; # the link was deleted but we've returned to this page because # of some error. if (exists $ARGS{"url$id"} && ! length $ARGS{"url$id"}) { push @links, { id => $id, url => undef }; } elsif (exists $ARGS{"url$id"} && length $ARGS{"url$id"}) { push @links, { id => $id, url => $ARGS{"url$id"}, description => $ARGS{"description$id"} }; } else { push @links, { id => $id, url => $link->url, description => $link->description }; } } my %current_categories; if (@category_ids) { %current_categories = map { $_ => 1 } @category_ids; } else { %current_categories = map { $_->category_id => 1 } $project->Categories->all_rows; } my $member_count = $Schema->ProjectMember_t->row_count ( where => [ $Schema->ProjectMember_t->project_id_c, '=', $project->project_id ] ); my %form_vals; foreach my $field ( qw( name description difficulty project_status_id project_support_level_id ) ) { $form_vals{$field} = exists $ARGS{$field} ? $ARGS{$field} : $project->$field( ); } $form_vals{role_id} = $ARGS{role_id} || 0; # Only used if a project has no members (i.e. a new project) my $roles; $roles = $Schema->Role_t->all_rows( order_by => $Schema->Role_t->role_id_c ) unless $member_count; </%init> -
/logged_in/new_project_submit.html
Here we handle creating a new project, along with its associated members, categories, and links. It looks fairly similar to /users/new_user_submit.html.
Since this is a new project, we give it a single member, which is the submitting user. This user is flagged as having administrative access to the project, meaning that they can edit the project.
-
/logged_in/editable_project_list.html
This component is used to display a list of projects for which the current user has administrative privileges. It provides links to edit each project's data and membership as well as a project deletion link.
-
/logged_in/edit_project.html
There is nothing here that we haven't seen before. Let's move on, shall we?
-
/logged_in/check_access_to_project.mas
This is a helper component that is called from several places in order to confirm that a user should be allowed to edit a given project. Basically, the user must be a site administrator or have administrative privileges for the project in question.
<%args> $project </%args> <%init> unless ($User->is_admin || $User->is_project_admin($project)) { $m->comp( '/lib/redirect.mas', path => '/' ); } </%init> -
/logged_in/edit_project_submit.html
While similar to the component used to edit users, this one is a bit more complicated. To detect the fact that a project should no longer be in a category, we need to check the project's current list of categories in the database against those submitted to this component. Similarly, we need to check the submitted list to see if there are any categories not already assigned to the project.
For links, we delete any existing link where the URL was erased from the text editing box. For others we simply update them. Then if new links were given, we add them to the database.
<%args> $project_id @project_link_ids => ( ) @category_ids => ( ) </%args> <%init> my $project = eval { $Schema->Project_t->row_by_pk( pk => $project_id ) } || $m->comp( '/lib/redirect.mas', path => '/' ); $m->comp( 'check_access_to_project.mas', project => $project ); eval { $project->update ( name => $ARGS{name}, description => $ARGS{description}, difficulty => $ARGS{difficulty}, project_status_id => $ARGS{project_status_id}, project_support_level_id => $ARGS{project_support_level_id}, ); }; $m->comp( '/lib/redirect.mas', path => '/logged_in/edit_project.html', query => { %ARGS, errors => $@->errors } ) if $@ && UNIVERSAL::isa( $@, 'Apprentice::Exception::DataValidation' ); my %current_categories = map { $_->category_id => 1 } $project->Categories->all_rows; foreach my $id (@category_ids) { $Schema->ProjectCategory_t->insert( values => { project_id => $project_id, category_id => $id } ) unless exists $current_categories{$id}; } { # This is the categories selected on the project editing page. my %selected_categories = map { $_ => 1 } @category_ids; # These are categories the project currently has which were # _not_ selected on the editing page. my @to_delete; foreach my $id (keys %current_categories) { push @to_delete, $id unless $selected_categories{$id}; } if (@to_delete) { foreach ( $Schema->ProjectCategory_t->rows_where ( where => [ [ $Schema->ProjectCategory_t->project_id_c, '=', $project_id ], [ $Schema->ProjectCategory_t->category_id_c, 'IN', @to_delete ] ] )->all_rows ) { $_->delete; } } } { # This is basically the same logic as was used for categories # except that if a link wasn't deleted, we may need to update # it. my @to_delete; foreach my $id (@project_link_ids) { if ( defined $ARGS{"url$id"} && length $ARGS{"url$id"} ) { my $link = eval { $Schema->ProjectLink_t->row_by_pk( pk => $id ) } || next; $link->update( url => $ARGS{"url$id"}, description => $ARGS{"description$id"} ); } else { push @to_delete, $id } } if (@to_delete) { foreach ( $Schema->ProjectLink_t->rows_where ( where => [ $Schema->ProjectLink_t->project_link_id_c, 'IN', @to_delete ] )->all_rows ) { $_->delete; } } } # Finally, insert any new links from the previous page. foreach (1..2) { if (exists $ARGS{"new_url$_"} && length $ARGS{"new_url$_"}) { $Schema->ProjectLink_t->insert ( values => { project_id => $project->project_id, url => $ARGS{"new_url$_"}, description => defined $ARGS{"new_description$_"} ? $ARGS{"new_description$_"} : $ARGS{"new_url$_"}, } ); } } $m->comp( '/lib/redirect.mas', path => '/logged_in/edit_project.html', query => { project_id => $project_id } ); </%init> <%flags> inherit => '/syshandler' </%flags> -
/logged_in/edit_members.html
Because the project editing screen already had enough on it, we decided to give project member editing its own distinct page in order to avoid interface overload.
We intentionally do not allow a user to give or take away administrative privileges from an existing member. It would have complicated the interface with another button, and it is easy enough to simply remove the member and re-add them with changed privileges.
We also don't allow a user to remove himself from the project, because this is more likely to be something someone does by accident than intentionally. And if a user removes himself, he could end up leaving the project with no one capable of editing it other than the site admins.
<table width="100%" cellspacing="0" cellpadding="5"> <tr> <td class="heading" colspan="5"> <h2 class="headline">Edit Project Members</h2> </td> </tr> <tr> <td colspan="2"> <a href="<& /lib/url.mas, path => '/logged_in/edit_project.html', query => { project_id => $project->project_id } &>"> Edit project</a> </td> </tr> <tr> <td colspan="5"><h3>Current members for <% $project->name | h %></h3></td> </tr> % while (my $member = $members->next) { <tr> <td><% $member->username | h %></td> <td><% $member->role %></td> <td> % if ($member->is_project_admin) { <b>Project admin</b> % } else { % } </td> % if ( $member->username eq $User->username ) { <td colspan="2"> </td> % } else { <form action="<& /lib/url.mas, path => 'remove_project_member.html' &>" method="POST"> <input type="hidden" name="project_id" value="<% $project_id %>"> <input type="hidden" name="user_id" value="<% $member->user_id %>"> <td colspan="2"><input type="submit" value="Remove"></td> </form> % } </tr> % } <tr> <td colspan="5"><h3>Add a new member</h3></td> </tr> % if ($error) { <tr> <td colspan="5"><span class="error"><% $error | h %></span></td> </tr> % } <form action="<& /lib/url.mas, path => 'add_project_member.html' &>" method="POST"> <input type="hidden" name="project_id" value="<% $project_id %>"> <tr> <td><input type="text" name="username" value="<% $username | h %>"></td> <td> <select name="role_id"> % while (my $role = $roles->next) { <option value="<% $role->role_id %>" <% $role_id == $role->role_id ? 'selected="selected"': '' %>> <% $role->role | h %> </option> % } </td> <td> As admin? <input type="checkbox" name="is_project_admin" value="1" <% $is_project_admin ? 'checked="checked"': '' %>> </td> <td><input type="submit" value="Add"></td> </tr> </form> </table> <%shared> my $project = eval { $Schema->Project_t->row_by_pk ( pk => $m->request_args->{project_id} ) } || $m->comp( '/lib/redirect.mas', path => '/' ); </%shared> <%args> $project_id $username => '' $role_id => 0 $is_project_admin => 0 $error => '' </%args> <%init> $m->comp( 'check_access_to_project.mas', project => $project ); my $members = $Schema->join( select => $Schema->ProjectMember_t, join => [ $Schema->tables( 'ProjectMember', 'User' ) ], where => [ $Schema->ProjectMember_t->project_id_c, '=', $project_id ], order_by => $Schema->User_t->username_c ); my $roles = $Schema->Role_t->all_rows( order_by => $Schema->Role_t->role_id_c ); </%init> <%method title> <& PARENT:title &> - Members of <% $project->name | h %> </%method> -
/logged_in/add_project_member.html
This component makes sure that the submitted username actually exists and, assuming it does, inserts a new row into the ProjectMember table.
-
/logged_in/remove_project_member.html
This component checks access, deletes a row from the database, and redirects.
-
/logged_in/delete_project.html
This is much like the component used to remove a project member. The main difference here is that we try to be intelligent in determining where to redirect the user after deleting the project. If she still has projects, we send her back to her list of projects. Otherwise, we simply send her to the top-level page.
<%args> $project_id $redirect_to => undef </%args> <%init> my $project = $Schema->Project_t->row_by_pk( pk => $project_id ); $m->comp( 'check_access_to_project.mas', project => $project ); $project->delete; unless ($redirect_to) { $redirect_to = $User->has_projects ? '/logged_in/editable_project_list.html' : '/'; } $m->comp( '/lib/redirect.mas', path => $redirect_to ); </%init> <%flags> inherit => '/syshandler' </%flags>
The last components we have to look at are in the /admin directory. These are:
-
/admin/autohandler
This is almost identical to /logged_in/autohandler but with a different access check and title method.
-
/admin/user_list.html
This component presents a paged list of users for site administrators to browse through. A link for each user allows the admin to edit that user.
-
/admin/edit_user.html
This one is almost identical to the /logged_in/edit_self.html component except that it takes a
$user_idparameter in order to allow any user to be edited. It uses the /users/user_form.mas component, like other user editing components. -
/admin/edit_categories.html
This component provides a form that allows categories to be edited, deleted, or added.
-
/admin/alter_category.html
An admin can alter a category's name.
-
/admin/add_category.html
This one adds a new category.
-
/admin/delete_category.html
This component deletes an existing category.
All Done
And that is our site. Putting this site together took maybe 30-40 person-hours from start to finish, which is not too bad. Plenty of that time was spent fiddling with HTML, since that is not our strongest area. Doing this as a traditional CGI application without Mason would probably have either taken much longer to achieve a similar level of code reuse or just ended up as a sloppier application.
Further Directions
As we mentioned at the beginning of this chapter, we wanted to make this site small enough to show you in a single chapter (albeit a rather long chapter), and we sometimes avoided using some features of Alzabo that could have simplified some of the code in order to avoid getting sidetracked into an Alzabo how-to. When you're designing your own sites, you won't have these constraints. Here are some things you might try adding to this site:
-
More inheritance
Note that the final three components, /admin/add_category.html, /admin/alter_category.html, and /admin/delete_category.html, all share certain properties, like the fact that they redirect to the same place and all inherit from /syshandler. It would be possible to encapsulate this common behavior in a component that all of them could inherit from.
-
Use Alzabo more effectively
Since Alzabo is able to provide metadata about the database (such as column names, types, lengths, etc.), we could have made form widget components to create form elements with the proper
sizeandmaxlengthattributes for a given column. In fact, Alzabo includes Mason components for this purpose in its distribution, but in the interest of not turning this into an Alzabo tutorial, we chose not to use them. -
Two-level component root
If you plan to replicate this kind of site in more than one location, you have two options. The first is to install the components and modules separately in each location. The second is to create a common set of shared components for all sites in one component root, overriding only the portions you need to override in another component root. This creates a more portable site framework. See "Inheritance and Multiple Component Roots" in Chapter 5.
One way to start creating such a framework is to move all our components to a shared component root and override only the parts you need to override in your site-specific root. This approach will take some reengineering as you go, but it's a fairly painless approach to the problem of generalizing a site that was designed as a one-off.
Footnotes
1. Or pseudopseudocode, since it's actually code. -- Return.
2. Famous last words, no doubt. Bug reports are always welcome, of course. -- Return.
3. See Chapter 11 for some session code examples. -- Return.
These HTML pages were created by running this script against the pseudo-POD source.