Skip to content

Instantly share code, notes, and snippets.

@rafl
Forked from dhoss/Lite.pm
Created July 29, 2009 07:29
Show Gist options
  • Save rafl/157916 to your computer and use it in GitHub Desktop.
Save rafl/157916 to your computer and use it in GitHub Desktop.
devin@devin-laptop:~/web-devel/server-lite$ perl -Ilib bin/lite.pl --logfile server-lite --port 3000 --pid /tmp/server-lite.pid --dir tasks/
Can't call method "new" without a package or object reference at bin/lite.pl line 111, <DATA> line 16.
devin@devin-laptop:~/web-devel/server-lite$ perl -Ilib bin/lite.pl --logfile server-lite --port 3000 --pid /tmp/server-lite.pid --dir tasks/
Attribute (pid_file) is required at /usr/local/share/perl/5.10.0/Moose/Meta/Class.pm line 240
Moose::Meta::Class::_construct_instance('Moose::Meta::Class=HASH(0x1e076f0)', 'HASH(0x31cc318)') called at /usr/local/lib/perl/5.10.0/Class/MOP/Class.pm line 361
Class::MOP::Class::new_object('Moose::Meta::Class=HASH(0x1e076f0)', 'HASH(0x31cc318)') called at /usr/local/share/perl/5.10.0/Moose/Meta/Class.pm line 205
Moose::Meta::Class::new_object('Moose::Meta::Class=HASH(0x1e076f0)', 'HASH(0x31cc318)') called at /usr/local/share/perl/5.10.0/Moose/Object.pm line 26
Moose::Object::new('WMC::Server::Lite::App') called at bin/lite.pl line 111
#!/usr/bin/env perl
package WMC::Server::Lite::App;
use Moose;
use namespace::autoclean;
use WMC::Server::Lite;
use IO::File;
use MooseX::Types::Moose qw/Str Int/;
with 'MooseX::Getopt';
$SIG{'TERM'} = \&graceful_shutdown;
has logfile => (
is => 'ro',
isa => Str,
traits => [qw(Getopt)],
cmd_aliases => 'l',
documentation => qq{ specify a log name for syslog },
required => 1,
);
has task_dir => (
is => 'ro',
isa => Str,
traits => [qw(Getopt)],
cmd_aliases => 'dir',
documentation => qq{ the directory where task queues are stored },
required => 1,
);
has pid_file => (
is => 'ro',
isa => Str,
traits => [qw(Getopt)],
cmd_aliases => 'pid',
documentation => qq{ name of the pidfile to be written to },
required => 1,
);
has port => (
is => 'ro',
isa => Int,
traits => [qw(Getopt)],
cmd_aliases => 'p',
documentation => qq{ specify a port to listen to },
required => 1,
);
sub recorder_prefix { # set the log file for recorder
DateTime->now . shift->port;
}
sub net_server {
"Net::Server::PreForkSimple";
}
sub bad_request {
print "HTTP/1.0 404 Bad request\r\n";
}
sub write_pid {
my ($self, $pid) = @_;
my $fh = IO::File->new;
my $pid_file = $self->pid_file;
if ($fh->open("> $pid_file") ) {
print $fh "$pid\n";
undef $fh;
} else {
warn("Cannot open: $pid_file: $!");
}
}
sub graceful_shutdown {
my ($self, $cgi) = @_;
print "Shutting down...\n";
$self->logger->log(
level => "notice",
message => "TERM received. Shutting down..."
);
`rm $self->pid_file`;
}
sub init {
my ($self) = shift;
## start the server
if (!@ARGV) {
print "usage: perl bin/lite.pl [options]\n";
exit;
}
my $server = WMC::Server::Lite->new;
my $logger = Log::Dispatch::Syslog->new(
name => $self->logfile,
min_level => 'info', );
$server->logger($logger);
$server->dir($self->task_dir);
my $pid = $server->background();
$self->write_pid($pid);
}
my $server = __PACKAGE__->new_with_options;
$server->init;
1;
package WMC::Server::Lite;
use Moose;
use HTTP::Server::Simple;
use IO::Socket::SSL;
use IO::File;
use Regexp::Common qw /URI/;
use DateTime;
use File::Spec;
use Log::Dispatch::Syslog;
use Data::Dumper;
use MooseX::Types::Moose qw/Str Int/;
use namespace::autoclean;
extends qw/HTTP::Server::Simple::CGI/ ;
has logger => (
is => 'rw',
isa => 'Log::Dispatch::Output',
required => 1,
);
has dir => (
is => 'rw',
isa => Str,
required => 1,
);
sub get_dispatch {
my ($self, $path) = @_;
my %dispatch = (
'/do' => \&handle_it,
);
return $dispatch{$path};
}
sub handle_request {
my ($self, $cgi) = @_;
my $path = $cgi->path_info();
my $handler = $self->get_dispatch($path);
if (ref($handler) eq "CODE") {
print "HTTP/1.0 200 OK\r\n";
$handler->($self, $cgi);
} else {
print "HTTP/1.0 404 Not found\r\n";
print $cgi->header,
$cgi->start_html('Not found'),
$cgi->h1('Not found'),
$cgi->end_html;
}
}
#sub accept_hook {
# my $self = shift;
# my $fh = $self->stdio_handle;
# $self->SUPER::accept_hook(@_);
# my $newfh =
# IO::Socket::SSL->start_SSL( $fh,
# SSL_server => 1,
# SSL_use_cert => 1,
# SSL_cert_file => 'myserver.crt',
# SSL_key_file => 'myserver.key',
# )
# or warn "problem setting up SSL socket: " . IO::Socket::SSL::errstr();
# $self->stdio_handle($newfh) if $newfh;
#}
sub handle_it {
my ($self, $cgi) = @_;
return if !ref $cgi;
my $dir = $self->dir;
my $prefix = $cgi->param('prefix');
my $goes_in_queue = $cgi->param('to_queue');
my $to_url = $cgi->param('url');
my $now = DateTime->now;
my $activity = File::Spec->catdir($dir, "$goes_in_queue$now");
print $cgi->header;
unless ( !$prefix or !$goes_in_queue or $to_url !~ /$RE{URI}{HTTP}/ ) {
my $fh = new IO::File;
if ( $fh->open(">$activity") ){
print $fh "$goes_in_queue" or print $cgi->h1("File IO Error:$!");
$fh->close;
$self->logger->log( level => "info", message =>$cgi->remote_addr . "\t" . "URL: $to_url\t" .
"Prefix: $prefix \t Command: $goes_in_queue \t Status: Success\n" ) or die "Error: $!";
}
print $cgi->start_html('Success!'),
$cgi->h1("Successfully handled request"),
$cgi->p("Dir: " . get_task_dir()),
$cgi->end_html;
} else {
print $cgi->start_html('Fail!'),
$cgi->h1("Missing required parameters!"),
$cgi->end_html;
$self->logger->log( level => "error", message => $cgi->remote_addr . "\t" . "URL: $to_url\t" .
"Prefix: $prefix \t Command: $goes_in_queue \t Status: Failed\n" ) or die "Error: $!";
}
}
1;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment