CGI::AppEasy - a quick way to give your perl program a web-based user interface

This module makes it a snap to give your perl program a web-based user interface. It adds a little wrapper around the essential interfaces of HTTP::Daemon (which, thankfully, is a core module).

This module makes certain assumptions and imposes certain constraints on how your program will interpret http requests, which in turn constrains the space of valid URLs which can be requested of your program. However, what is allowed should be sufficient for most simple needs. If you need more sophisticated web request handling, there are plenty of options, ranging all the way up to Apache+mod_perl or any number of content management systems.

The essence is this: each (valid) path (part of the URL) is mapped to a function in your code. The query part of the URL is parsed and is passed to the function as hash-like "named" arguments. For example, to call the sub Update whenever the URL path part is /update, configure your CGI::AppEasy object like so:

    '/update' => \&Update,
[download]

The sub should be defined like so:

sub Update
{
    my $appeasy = shift; # your CGI::AppEasy object
    ....
    return qq(<h1>update successful</h1>) # or whatever
}
[download]

The html blob returned by such handler functions is sent to the browser as is.

If you need to set the http status code to something other than 200, you can do

    $appeasy->response->code( 404 ); # or whatever
[download]

If you don't do that, code 200 (Success) will be returned.

$appeasy->response is the HTTP::Response object which will be sent to the client. You have full access to that object, if, for example, you want to set cookies, or change the returned content type to something other than text/html, or whatever.

You can also associate a command with a "static" blob of text, rather than a function:

    '/help' => \$help_text,
[download]

You should probably have a command handler for the "default" case:

    '/' => \$default_page,
[download]

Note that partial path matching is done, so that if you have defined a handler for path /foo and you request the path /foo/bar, that will get handled by your /foo handler. The full path of the request is available via the method path. This makes it possible to define just one handler, for path /, and do your own path inspection/handling.

The default port is 8080 but you can override this via the named parameter LocalPort when you construct or call serve.

$appeasy->cgi is a CGI object containing virtually all of the info you would need to handle the request. I've tried to initialize it with as much info from the request as I can, but I don't guarantee that it is as complete as a CGI object would be if running under a "real" http server (such as Apache).

See my reply below for a complete working example application. (NOTE: not sync'd to the current version of the module.)


=pod

Version: 20100504.2

Brief example:

 use CGI::AppEasy;

 CGI::AppEasy->new( '/' => \&cmd, )->serve;

 sub cmd
 {
   my( $easy ) = @_;
   $easy->response->code( 404 );
   "<h1>Command <tt>".$easy->path_info."</tt> not found</h1>"
 }


=cut

package CGI::AppEasy;

use HTTP::Daemon;
use HTTP::Status;
use URI;
use URI::QueryParam;
use Data::Dumper;
use strict;
use warnings;


sub new
{
    my( $pkg, %config ) = @_;
    bless \%config, $pkg
}

# read-only access to these contained objects:
sub request   { $_[0]{'request'} }
sub response  { $_[0]{'response'} }
sub daemon    { $_[0]{'daemon'} }
sub uri       { $_[0]{'uri'} }

sub server_name { $_[0]{'server_name'} }
sub server_port { $_[0]{'server_port'} }
sub remote_port { $_[0]{'remote_port'} }
sub remote_host { $_[0]{'remote_host'} }
sub remote_addr { $_[0]{'remote_addr'} }

# delegation calls:
sub path_info        { $_[0]->uri->path }
sub query            { $_[0]->uri->query }
sub request_method   { $_[0]->request->method }
sub protocol         { $_[0]->request->protocol }
sub content_type     { $_[0]->request->content_type } # via Header
sub content_length   { $_[0]->request->content_length } # via Header
sub content_encoding { $_[0]->request->content_encoding } # via Header
sub content_language { $_[0]->request->content_language } # via Header
sub referer          { $_[0]->request->referer } # via Header
sub user_agent       { $_[0]->request->user_agent } # via Header
# note that http('host') returns the server hostname, not the requeste
+r's hostname
sub host             { $_[0]->request->header('Host') }
sub Accept           { $_[0]->request->header('Accept') }
sub accept_charset   { $_[0]->request->header('Accept-Charset') }
sub accept_encoding  { $_[0]->request->header('Accept-Encoding') }
sub accept_language  { $_[0]->request->header('Accept-Language') }
sub keep_alive       { $_[0]->request->header('Keep-Alive') }


sub return
{
    my( $self, $content ) = @_;
    $self->{content_set}=1;
    $self->response->content($content);
    $content
}
sub end
{
    my $self = shift;
    $self->{'serving'} = 0;
    $self
}

sub serve
{
    my $self = shift;
    my %config = (
        LocalPort => 8080,
        Blocking => 1, # default from IO::Socket::INET
        Timeout => 5, 
        %$self, @_ );

    $self->{'daemon'} = 
    my $d = HTTP::Daemon->new(
        LocalPort => $config{'LocalPort'}||8080,
    ) or die;

    warn "contact ", $d->url, "\n";

    $self->{'serving'} = 1;

    my($c,$peer_addr);
    while ( $self->{'serving'} and ($c,$peer_addr) = $d->accept and $c
+ )
    # if timeout, $c will be undef
    # how to handle this case?
    # more to the point - when does this actually happen?
    # my rudimentary attempts to trigger it failed.
    {
        {
            my($port,$iaddr) = sockaddr_in( $peer_addr );
            $self->{'remote_port'} = $port;
            $self->{'remote_host'} = gethostbyaddr($iaddr,AF_INET);
            $self->{'remote_addr'} = inet_ntoa($iaddr);
        }

        while ( $self->{'serving'} and my $r = $c->get_request )
        {
            warn "\nRequest:\n".$r->as_string;
            $self->{'request'} = $r;
            $self->{'uri'} = URI->new( $r->url, $d->url );
            ( $self->{'server_name'}, $self->{'server_port'} ) = $r->h
+eader('Host') =~ /(.*):(.*)/;

            my $params_hr = $self->uri->query_form_hash; # not current
+ly used here

            $self->{'response'} = HTTP::Response->new(
                RC_OK,
                undef,
                [    # headers
                    'Content-type' => 'text/html',
                ],
            );

            # XXX currently, only GET method is supported
            $r->method eq 'GET' or $c->send_error( RC_METHOD_NOT_ALLOW
+ED ), next;

            # if the path matches a defined cmd handler exactly, just 
+go with that.
            # otherwise, try to find a matching prefix among the defin
+ed handlers.
            my $path = $self->uri->path;
            my $cmd = $config{$path} ? $path : (sort { ($a =~ m,/,g) <
+=> ($b =~ m,/,g) or length($b) <=> length($a) } grep { $path =~ /^\Q$
+_\E\b/ } keys %config)[0];
            defined $cmd and $cmd eq '/' && $cmd ne $path and undef $c
+md; # but don't accept '/' as a matching prefix.

            if ( $cmd )
            {
                if ( ref($config{$cmd}) eq 'CODE' )
                {
                    $self->{'content_set'}=0;
                    my $ret = $config{$cmd}->( $self );
                    $self->return($ret) unless $self->{'content_set'};
                    # ignore returned value if the handler has called 
+->return()!
                }
                elsif ( ref($config{$cmd}) eq 'SCALAR' ) # text
                {
                    $self->return( ${ $config{$cmd} } );
                }
                else
                {
                    $self->response->code( RC_NOT_FOUND );
                    $self->return( <<EOF );
<h1>Error:</h1>
<p>Command '$cmd' not recognized at this time!</p>
EOF
                }
            }
            else
            {
                $self->response->code( RC_NOT_FOUND );
                $self->return( <<EOF );
<h1>Error:</h1>
<p>Command path '$path' not recognized at this time!</p>
EOF
            }

            $c->send_response( $self->response );
        }
        $c->close;
        undef $c;
    }
}

sub continue_link
{
    my $context = shift;
    my $text = shift;
    my $cmd = '/'; @_ % 2 and $cmd = shift;
    my %args = @_;
    my $uri = new URI;
    $uri->path( $cmd );
    $uri->query_form( %args );
    qq(<a href="$uri">$text</a>)
}

sub continue_formstart
{
    my $context = shift;
    my $cmd = '/'; @_ % 2 and $cmd = shift;
    my %args = @_;
    join '',
    qq(<form action="$cmd" method="get" enctype="application/x-www-for
+m-urlencoded" style="display:inline">),
    map( qq(<input type="hidden" name="$_" value="$args{$_}" />), keys
+ %args ),
}

sub continue_button # a form containing a single button, plus optional
+ly some hidden args
{
    my $context = shift;
    my $text = shift;
    join '',
    $context->continue_formstart( @_ ), # cmd (optionally), and args
    qq(<input type="submit" value="$text" />),
    '</form>'
}

use Exporter;
our @ISA=qw(Exporter);
our @EXPORT_OK=qw( %LINK %FORMSTART %BUTTON );
{
package Tie::EmbedFunc;
sub TIEHASH { bless $_[1], $_[0] } 
sub FETCH { join $", $_[0]->( split $; => $_[1] => -1 ); } 
}
tie our %LINK,      'Tie::EmbedFunc', sub { __PACKAGE__->continue_link
+(@_) };
tie our %FORMSTART, 'Tie::EmbedFunc', sub { __PACKAGE__->continue_form
+start(@_) };
tie our %BUTTON,    'Tie::EmbedFunc', sub { __PACKAGE__->continue_butt
+on(@_) };

=pod

if you say

  use CGI::AppEasy qw( $BUTTON );

then you do this in your code:

  $html = "... $BUTTON{'Recalc','/recalc',foo=>42} ...";

of course, you don't have to pollute your own namespace if you don't w
+ant to:

  use CGI::AppEasy;

  $html = "... $CGI::AppEasy::BUTTON{'Recalc','/recalc',foo=>42} ...";

You can even use your own variable if you wish:

  use CGI::AppEasy;

  our %Button; *Button = \%CGI::AppEasy::BUTTON;

  $html = "... $Button{'Recalc','/recalc',foo=>42} ...";

=cut

__PACKAGE__
[download]

What is the sound of Windows? Is it not the sound of a wall upon which people have smashed their heads... all the way through?

Comment on CGI::AppEasy - a quick way to give your perl program a web-based user interface Select or Download Code

Replies are listed 'Best First'.
Re: CGI::AppEasy - a quick way to give your perl program a web-based user interface by jdporter (Paladin) on Apr 13, 2010 at 18:44 UTC
This is a working sample application for the CGI::AppEasy module above. Read more... (3 kB) What is the sound of Windows? Is it not the sound of a wall upon which people have smashed their heads... all the way through?	[reply] [d/l]
Re: WebGUI::Easy - a quick way to give your perl program a web-based user interface by metaperl (Curate) on Apr 14, 2010 at 16:18 UTC
So you are using the WebGUI namespace even though this code does not make use of plain black's WebGUI Perl web app system? The mantra of every experienced web application developer is the same: thou shalt separate business logic from display. Ironically, almost all template engines allow violation of this separation principle, which is the very impetus for HTML template engine development. -- Terence Parr, "Enforcing Strict Model View Separation in Template Engines"	[reply]
Re^2: WebGUI::Easy - a quick way to give your perl program a web-based user interface by jdporter (Paladin) on Apr 14, 2010 at 16:36 UTC
I checked CPAN; no one has staked any claims in the WebGUI namespace. Apparently I'm going to have to rename anyway, though, because Plain Black have trademarked "WebGUI". Thanks for the tip. Any suggestions?	[reply]
Re^3: WebGUI::Easy - a quick way to give your perl program a web-based user interface by metaperl (Curate) on Apr 15, 2010 at 14:11 UTC
I really like this app. I fear it is going to consume much of my free time now that it is so easy to produce webapps :) It competes with Squatting in terms of simplicity. But anyway, it doesnt really webify a command-line app, or something like `App::ToWeb` would be appropriate. To me, it seems like `CGI::Quick` or `CGI::Now` would be a good name. The mantra of every experienced web application developer is the same: thou shalt separate business logic from display. Ironically, almost all template engines allow violation of this separation principle, which is the very impetus for HTML template engine development. -- Terence Parr, "Enforcing Strict Model View Separation in Template Engines"	[reply] [d/l] [select]
Re^4: WebGUI::Easy - a quick way to give your perl program a web-based user interface by jdporter (Paladin) on Apr 15, 2010 at 15:43 UTC
Try Continuity :) by awwaiid (Friar) on Apr 23, 2010 at 19:16 UTC
Some notes below your chosen depth have not been shown here
Re: WebGUI::Easy - a quick way to give your perl program a web-based user interface by metaperl (Curate) on Apr 15, 2010 at 14:17 UTC
You seem to be developing something along the lines of webpy. Are you aware of that? The mantra of every experienced web application developer is the same: thou shalt separate business logic from display. Ironically, almost all template engines allow violation of this separation principle, which is the very impetus for HTML template engine development. -- Terence Parr, "Enforcing Strict Model View Separation in Template Engines"	[reply]
Re^2: WebGUI::Easy - a quick way to give your perl program a web-based user interface by jdporter (Paladin) on Apr 15, 2010 at 15:40 UTC
Negative. I don't follow the goings-on in the world of Python. But thanks for the tip!	[reply]
Re: CGI::AppEasy - a quick way to give your perl program a web-based user interface by jdporter (Paladin) on Mar 09, 2011 at 21:49 UTC
For an enterprise-grade variant of the same idea, check out Dancer. (Thanks to teamster_jr for the tip.)	[reply]