(You are Anonymous)

An Example of a login/logout application with CGI:::Application

By Zbigniew Lukasiak

Perhaps someone would find this example useful. This is a minimal CGI::Application with user login/logout feature. It uses Template::Toolkit and CGI::Session. It has only two pages. The login form accepts users with the same nick as password - this is only for displaying the login mechanism.

When the user is not logged in a login form is displayed, if the user is logged in he can logout through a logout link. The login form after the login should take the user back to the same page.

It is composed of one script, one module inheriting from CGI::Application and 4 template files. All of them should be placed into one directory. It uses the '/tmp' directory as a session data storage, so it should be writable by the user that apache uses for cgi execution.

Bellow I post all of those 6 files. If someone has an idea where to post the tarball of the whole set please let me know.

The script (save it as index.pl):

#!/usr/bin/perl -w
use MinimalApp;
my $webapp = MinimalApp->new();
$webapp->run();

The template of the home page (save it as index.tt2):

[% INCLUDE header.tt2 %]
This is the home page.
<hr />
[% INCLUDE footer.tt2 %]

The template of the other page (save it as page1.tt2):

[% INCLUDE header.tt2 %]
This is the other page.
<hr />
[% INCLUDE footer.tt2 %]

The template of the header file (save it as header.tt2):

<html>
[% IF debug %]
[% debug %]
<hr>
[% END %]
<a href="[%myurl%]">Homepage</a>|
<a href="[%myurl%]?rm=page1">The other page</a>|
<hr>

The template of the footer file (save it as footer.tt2):

[% BLOCK params %][%- IF qparams.keys.size %]?[%- FOREACH p = qparams.keys %][% p %]=[% qparams.$p %];[% END %][% END %][% END %]
[% IF profile.nick %]
  <a href="[%myurl%]?rm=logout">Logout</a>
[% ELSE %]
[% IF badlogins %]
Wrong nick or password. [% badlogins %] attempts.<br>
[% END %]
<form method="post" action="[%myurl%][%- PROCESS params %]" enctype="application/x-www-form-urlencoded">
nick: <input type="text" name="lg_nick"/><br/>
pass: <input type="password" name="lg_pass"/><br/>
[% FOREACH p = qparams.keys %]
<input type="hidden" name="[% p %]" value="[% qparams.$p %]">
[% END %]
<input type="submit" name="submit" value="Login" />
</form>
<hr/>
<a href="[%myurl%]?rm=regform">Register</a>
[% END %]
</html>

And here is the module code (save it as MinimalApp.pm): Minimal App

Here is an HTML::Template example

Disclaimer: I don't pretend to be a good Perl programmer. Since this is a Wiki I hope someone will suggest improvements.

So the instance script (index.pl) stays the same

#!/usr/bin/perl -w
use MinimalApp;
my $webapp = MinimalApp->new();
$webapp->run();

The template of the home page (save it as index.tmpl):

<TMPL_INCLUDE NAME="header.tmpl">
This is the home page.
<hr />
<TMPL_INCLUDE NAME="footer.tmpl">

The template of the other page (save it as page1.tmpl):

<TMPL_INCLUDE NAME="header.tmpl">
This is the other page.
<hr />
<TMPL_INCLUDE NAME="footer.tmpl">

The template of the header file (save it as header.tmpl):

<html>
<hr>
<a href="<TMPL_VAR NAME=MYURL>">Homepage</a>|
<a href="<TMPL_VAR NAME=MYURL>?rm=page1">The other page</a>|
<hr>

The template of the footer file (save it as footer.tmpl):

<TMPL_IF NAME="PROFILE">
      <a href="<TMPL_VAR NAME=MYURL>?rm=logout">Logout</a>
<TMPL_ELSE>
   <TMPL_IF NAME="BADLOGINS">
       Wrong nick or password. <TMPL_VAR NAME=BADLOGINS> attempts.<br/>
         </TMPL_IF>
   <form method="post" action="<TMPL_VAR NAME=MYURL>" enctype="application/x-www-form-urlencoded">
         nick: <input type="text" name="lg_nick"/><br/>
         pass: <input type="password" name="lg_pass"/><br/>
         <input type="submit" name="submit" value="Login" />
   </form>
   <hr/>
   <a href="<TMPL_VAR NAME=MYURL>?rm=regform">Register</a>
</TMPL_IF>
</html>

Minimal App.pm code:

package MinimalApp;
use base 'CGI::Application';
use strict;

use HTML::Template;
use CGI::Session;
use Data::Dumper;

sub cgiapp_init {
    my $self    = shift;
    my $query   = $self->query;
    # get the current session id from the cookie
    my $sid     = $query->cookie( 'CGISESSID' ) || undef;
    my $session = CGI::Session->new("driver:File", $sid, {Directory=>'/tmp'});
    $self->param( 'session' => $session);
    if (!$sid or $sid ne $session->id ) {
       my $cookie = $query->cookie(
          -name    => 'CGISESSID',
          -value   => $session->id,
          -expires => '+1y'
       );
       $self->header_props( -cookie => $cookie );
    }
    $self->login($query->param("lg_nick"), $query->param("lg_pass"));
}

sub login{
    my $self = shift;
    my($nick, $pass) = @_;
    my $session = $self->param('session');
    if(defined $nick and defined $pass){
        if($nick eq $pass){
            # replace this check above with something real ie lookup from a database
            $session->param(profile => {nick => $nick});
            $session->clear('badlogins');
        }else{
            my $badlogins = $session->param('badlogins') || 0;
            $session->param('badlogins' => ++$badlogins);
        }
    }
}

sub setup {
    my $self = shift;
    $self->start_mode('index');
    $self->run_modes(
        'index' => 'index',
        'page1' => 'page1',
        'logout' => 'logout'
    );
    $self->tmpl_path("/Library/Webserver/Documents/tmpls/test/");
}

sub logout{
    my $self = shift;
    my $session = $self->param('session');
    $session->clear('profile');
    return $self->index();
}

sub processtmpl{
# processes the template with parameters gathered from the application object
    my ($self,$tmplname) = @_;
    my $query = $self->query();
    my $template = $self->load_tmpl($tmplname, loop_context_vars => 1,);
    #my $tmplpar = $self->param('tmplpar') || {};
    $template->param(PROFILE => $self->param('session')->param("profile"));
    $template->param(BADLOGINS => $self->param('session')->param("badlogins"));
    $template->param(MYURL => $query->url());
    my $html = $template->output;
    return $html;
}

sub index{
    my $self = shift;
    return $self->processtmpl('index.tmpl');
}

sub page1{
    my $self = shift;
    return $self->processtmpl('page1.tmpl');
}

1;    # Perl requires this at the end of all modules

See also: