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

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_to parameter. 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_admin flag 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_to parameter 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 {
   &nbsp;
%   }
  </td>
%   if ( $member->username eq $User->username ) {
  <td colspan="2">&nbsp;</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_id parameter 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.

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