O'Reilly logo

Embedding Perl in HTML with Mason by Ken Williams, Dave Rolsky

Stay ahead with the world's most comprehensive technology and business learning platform.

With Safari, you learn the way you learn best. Get unlimited access to videos, live online training, learning paths, books, tutorials, and more.

Start Free Trial

No credit card required

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:

/syshandler
/news.mas
/project/dhandler
/autohandler
/featured_project.mas
/users/new_user.html
/apprentice.css
/all_projects.html
/users/user_form.mas
/left_side_menu.mas
/search_results.mas
/users/new_user_submit.html
/lib/url.mas
/lib/paging_controls.mas
/users/login_submit.html
/latest_projects.mas
/lib/redirect.mas
/users/logout.html
/lib/format_date.mas
/lib/set_login_cookie.mas
/users/forgot_password.html
/index.html
/user.html
/users/forgot_password_submit.html
/welcome.mas
/login_form.html
/show_category.html
  
/browse.html

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 $User object 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 $User object.

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::SHA1 module 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 an eval{} 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 inherit flag 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 _t return table objects, and that methods ending in _c return 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:title allows 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.

Perl Apprentice site index page

Figure 8-1. Perl Apprentice site index page

The 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.

Perl Apprentice site divided into pieces

Figure 8-2. Perl Apprentice site divided into pieces

As 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 Bjrn Hansen for the perl.org sites, including http://dev.perl.org/ and http://jobs.perl.org/.

Setting the inherit flag to undef ensures 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 $User object 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_args hash 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">&nbsp;</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">&nbsp;</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">&nbsp;</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">&nbsp;</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">&nbsp;</td>
 </tr>
 <tr>
  <td colspan="2">
   <a href="mailto:dave@perl.org">Complaints / Compliments?</a>
  </td>
 </tr>
 <tr>
  <td colspan="2">&nbsp;</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 %query hash. For these, it would be necessary for us to use a session mechanism rather than trying to pass them around in the URL.[19]

Because the URI object’s query_form( ) method doesn’t allow hash references, we convert any hash references we find in the %query values to array references before passing %query to the query_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">&nbsp;</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 24, 1970”) or long (“February 24, 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_id variable in the <%init> section. If this value is set to zero or undef, 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 @ids variable 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 {
&nbsp;
%   }
  </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::FromText module (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 the paras => 1 parameter 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 $start and $limit arguments are part of the results 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 $summary and $count arguments 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 the limit and start arguments 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 {
   &nbsp;
% }
  </td>
  <td width="7%">
% if ( $current_page > 1 ) {
   <a href="<& /lib/url.mas,
               path => $r->uri,
               query => { start => $start - $limit,
                          limit => $limit,
                          %query }
             &>">&lt;&lt;</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 {
   &nbsp;
%   }
% }
  </td>
  <td width="7%">
% if ( $current_page < $total_pages ) {
   <a href="<& /lib/url.mas,
               path => $r->uri,
               query => { start => $start + $limit,
                          limit => $limit,
                          %query }
             &>">&gt;&gt;</a>
% } else {
   &nbsp;
% }
  </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 {
   &nbsp;
% }
  </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 {
&nbsp;
%   }
  </td>
 </tr>
% }
% if ( $Schema->ProjectLink_t->row_count
%          ( where => [ $Schema->ProjectLink_t->project_id_c, '=', $project_id ] ) ) {
 <tr>
  <td colspan="2">&nbsp;</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">&nbsp;</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_url and %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_user object 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_status object 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 %ARGS hash. If there are values for these fields here, it assumes that these have priority because the only way for %ARGS to 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 $user object 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_to variable 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_to value 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_to variable.

Note that we will never set the is_admin flag 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 the scomp( ) method to get a URL in the form of a string from the /lib/url.mas component, then pass that to the redirect( ) 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>


[19] See Chapter 11 for some session code examples.

With Safari, you learn the way you learn best. Get unlimited access to videos, live online training, learning paths, books, interactive tutorials, and more.

Start Free Trial

No credit card required