Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

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

by jdporter (Canon)
on Apr 13, 2010 at 18:42 UTC ( #834554=CUFP: print w/replies, xml ) Need Help??

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,
The sub should be defined like so:
sub Update { my $appeasy = shift; # your CGI::AppEasy object .... return qq(<h1>update successful</h1>) # or whatever }
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
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,

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

'/' => \$default_page,

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__
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?

Replies are listed 'Best First'.
Re: CGI::AppEasy - a quick way to give your perl program a web-based user interface
by jdporter (Canon) on Apr 13, 2010 at 18:44 UTC

    This is a working sample application for the CGI::AppEasy module above.

    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?
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

      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?

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

      Negative. I don't follow the goings-on in the world of Python. But thanks for the tip!

Re: CGI::AppEasy - a quick way to give your perl program a web-based user interface
by jdporter (Canon) 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.)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://834554]
Approved by erzuuli
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (1)
As of 2021-10-28 05:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (95 votes). Check out past polls.

    Notices?