#!/usr/bin/perl -T
use warnings;
use strict;
use lib qw(lib);
use Getopt::Long;
use Readonly;
BEGIN {
$ENV{DOCUMENT_ROOT} = './htdocs';
}
use ClearPress::controller;
use GrandKids::view::error;
use GrandKids::util;
use GrandKids::view::child;
use GrandKids::model::child;
use GrandKids::view::family;
use GrandKids::model::family;
our $VERSION = do { my ($r) = q$LastChangedRevision: 348 $ =~ /(\d+)/smx; $r; };
Readonly::Scalar our $PORT => 8080;
my $opts = {};
GetOptions($opts, qw(port=s));
my ($port) = ($opts->{port} || $PORT) =~ /(\d+)/smx;
GrandKids::sa->new($port)->run;
0;
package GrandKids::sa;
use base qw(HTTP::Server::Simple::CGI);
use strict;
use warnings;
use Data::Dumper;
use Carp;
use English qw(-no_match_vars);
sub handle_request {
my ($self, $cgi) = @_;
my $EXTN = {
css => 'text/css',
xml => 'text/xml',
gif => 'image/gif',
png => 'image/png',
jpg => 'image/jpeg',
txt => 'text/plain',
html => 'text/html',
js => 'text/javascript',
};
my $util = GrandKids::util->new({
cgi => $cgi,
});
print "HTTP/1.0 200 OK\n";
my ($fn) = "htdocs$ENV{REQUEST_URI}" =~ m|([a-z\d_/\.\-%]+)|mix;
$fn =~ s|\.\./||smxg;
if(-f $fn) {
my ($ext) = $fn =~ /\.([^\.]+)$/smx;
my $type = $EXTN->{lc $ext} || 'application/octet-stream';
print qq(Content-type: $type\n\n);
carp qq(Serving static file $fn as $ext / $type);
open my $fh, $fn or croak "Opening $fn: $ERRNO";
while(<$fh>) {
print;
}
close $fh or croak "Closing $fn: $ERRNO";
} else {
ClearPress::controller->handler($util);
}
return 1;
}
sub print_banner {
my $self = shift;
print q[GrandKids development server up and running at http://localhost:].$self->port()."/\n";
return 1;
}
1;