package Yote::WebAppServer; # # Proof of concept server with main loop. # use strict; use forks; use forks::shared; use HTTP::Request::Params; use Net::Server::Fork; use MIME::Base64; use JSON; use CGI; use Data::Dumper; use Yote::AppRoot; use base qw(Net::Server::Fork); use vars qw($VERSION); $VERSION = '0.05'; my( @commands, %prid2wait, %prid2result, $singleton ); share( @commands ); share( %prid2wait ); share( %prid2result ); sub new { my $pkg = shift; my $class = ref( $pkg ) || $pkg; $singleton = bless {}, $class; return $singleton; } sub start_server { my( $self, @args ) = @_; my $args = scalar(@args) == 1 ? $args[0] : { @args }; Yote::ObjProvider::init( %$args ); # fork out for two starting threads # - one a multi forking server and the other an event loop. my $thread = threads->new( sub { $self->run( %$args ); } ); $self->{thread} = $thread; _poll_commands(); $thread->join; } #start_server sub shutdown { my $self = shift; print STDERR "Shutting down yote server \n"; &Yote::ObjProvider::stow_all(); print STDERR "Killing threads \n"; $self->{thread}->detach(); print STDERR "Shut down server thread.\n"; } #shutdown # # Sets up Initial database server and tables. # sub init_server { my( $self, @args ) = @_; Yote::ObjProvider::init_datastore( @args ); } #init_server # # Called when a request is made. This does an initial parsing and # sends a data structure to process_command. # # Commands are sent with a single HTTP request parameter : m for message. # # Commands have the following structure : # * a - app # * c - cmd # * d - data # * w - if true, waits for command to be processed before returning # # # This ads a command to the list of commands. If # sub process_request { my $self = shift; my $reqstr = <STDIN>; my $params = {map { split(/\=/, $_ ) } split( /\&/, $reqstr )}; my $command = from_json( MIME::Base64::decode($params->{m}) ); print STDERR Data::Dumper->Dump( [$command,'Inputted Command'] ); # return unless $ENV{REMOTE_ADDR} eq '127.0.0.1'; $command->{oi} = $params->{oi}; my $wait = $command->{w}; my $procid = $$; { print STDERR Data::Dumper->Dump(["Lock prid2wait"]); lock( %prid2wait ); $prid2wait{$procid} = $wait; print STDERR Data::Dumper->Dump(["Locked prid2wait"]); } # # Queue up the command for processing in a separate thread. # { print STDERR Data::Dumper->Dump(["Lock commands"]); lock( @commands ); print STDERR Data::Dumper->Dump(["Locked commands"]); push( @commands, [$command, $procid] ); cond_broadcast( @commands ); } if( $wait ) { while( 1 ) { my $wait; { lock( %prid2wait ); $wait = $prid2wait{$procid}; } if( $wait ) { lock( %prid2wait ); cond_wait( %prid2wait ); last unless $prid2wait{$procid}; } else { last; } } my $result; { lock( %prid2result ); $result = $prid2result{$procid}; delete $prid2result{$procid}; } print STDERR Data::Dumper->Dump([$result,"Result to Send"]); print "$result"; } else { print "{\"msg\":\"Added command\"}"; } } #process_request # # Run by a threat that constantly polls for commands. # sub _poll_commands { while(1) { my $cmd; { print STDERR "Extracting Command\n"; lock( @commands ); $cmd = shift @commands; print STDERR "Got Command\n"; } if( $cmd ) { print STDERR Data::Dumper->Dump([" in poll, Processing",$cmd]); _process_command( $cmd ); print STDERR Data::Dumper->Dump([" in poll, Done processing",$cmd]); } unless( @commands ) { print STDERR "Locking commands\n"; lock( @commands ); print STDERR "Waiting for commands\n"; cond_wait( @commands ); print STDERR "Got Command\n"; } } } #_poll_commands sub _process_command { my $req = shift; my( $command, $procid ) = @$req; Yote::ObjProvider::connect(); my $resp; eval { my $root = Yote::AppRoot::fetch_root(); my $ret = $root->process_command( $command ); print STDERR Data::Dumper->Dump([$ret,"Response"]); $resp = to_json($ret); Yote::ObjProvider::stow_all(); }; $resp ||= to_json({ err => $@ }); # # Send return value back to the caller if its waiting for it. # lock( %prid2wait ); { lock( %prid2result ); $prid2result{$procid} = $resp; } print STDERR Data::Dumper->Dump(["IN process, freeing prid2wait for",$resp]); delete $prid2wait{$procid}; cond_broadcast( %prid2wait ); Yote::ObjProvider::commit(); Yote::ObjProvider::disconnect(); } #_process_command 1; __END__ =head1 NAME Yote::WebAppServer - is a library used for creating prototype applications for the web. =head1 SYNOPSIS use Yote::WebAppServer; my $server = new Yote::WebAppServer(); $server->start_server( port =E<gt> 8008, =over 32 datastore => 'Yote::MysqlIO', db => 'yote_db', uname => 'yote_db_user', pword => 'yote_db-password' ); =back =head1 DESCRIPTION This starts an application server running on a specified port and hooked up to a specified datastore. Additional parameters are passed to the datastore. The server set up uses Net::Server::Fork receiving and sending messages on multiple threads. These threads queue up the messages for a single threaded event loop to make things thread safe. Incomming requests can either wait for their message to be processed or return immediately. =head1 BUGS There are likely bugs to be discovered. This is alpha software =head1 AUTHOR Eric Wolf =head1 LICENSE AND COPYRIGHT Copyright (C) 2011 Eric Wolf This module is free software; it can be used under the same terms as perl itself. =cut