Welcome

package REST; use strict; use CGI; our $DEBUG = 0; sub new { return bless {CGI => CGI->new}, shift }; sub cgi { shift()->{CGI} } sub debug { my ($self, $urls, @problems) = @_; my $cgi = $self->cgi; print $cgi->header, $cgi->start_html, "REST::debug executing: @problems

", "

$_: $urls->{$_}

", "Path info: ", $cgi->path_info, "
", "Request method: ", $cgi->request_method, "
", $cgi->end_html; } sub run { my ($self, %urls) = @_; my $pathInfo = $self->cgi->path_info; my $method = $self->cgi->request_method; my ($package, @pathParams); foreach my $path ( keys %urls ) { $package = $urls{$path}; if ( $pathInfo =~ $path ) { @pathParams = ($1, $2, $3, $4, $5, $6, $7, $8, $9); last; } undef $package; } if ( $package ) { my $dispatcher = $package->new($self->cgi); if ( $dispatcher->can($method) ) { $dispatcher->$method(@pathParams); return; } } if ( $DEBUG ) { $self->debug(\%urls, $@); } else { print $self->cgi->header, $self->cgi->start_html, $self->cgi->end_html; } } 1; ##

##

#!/usr/bin/perl -w
# (index.pl)
use strict;
use REST;
use HTML::Template;

my %urls = (
  qr{^/?$}         => 'Welcome',
  qr{^/hello$}     => 'NiceToMeetYou',
  qr{^/bye/(\w+)$} => 'Goodbye',
);

REST->new->run(%urls);

##

##

package Renderer;
# a class w/common functionality in all "application" classes

sub new {
  my ($class, $cgi) = @_;
  return bless { CGI => $cgi }, $class;
}

sub cgi { return shift->{CGI} }

sub render {
  my ($self, $content) = @_;
  my $templateText = q{
    
      Welcome
      
    
  };
  my $template = HTML::Template->new_scalar_ref(\$templateText);
  $template->param(CONTENT => $content);
  print $self->cgi->header(-type => 'text/html'), $template->output;
}


package Welcome;
use base 'Renderer';

sub GET {
  my $self = shift;
  $self->render(q{
    Welcome. My name is Perl. What's your name?
    
     
     
    
  });
}


package NiceToMeetYou;
use base 'Renderer';

sub POST {
  my $self = shift;
  my $name = $self->cgi->param('name'); # yes, it would be scrubbed in production code
  $self->render(qq{
    Nice to meet you $name.
     Leaving already?
  });
}


package Goodbye;
use base 'Renderer';

sub GET {
  my ($self, $name) = @_;
  $self->render("Goodbye, $name. It was nice visiting.");
}