--- trunk/lib/Frey/Server.pm 2008/08/31 17:44:03 179 +++ trunk/lib/Frey/Server.pm 2008/11/28 13:16:47 581 @@ -1,15 +1,18 @@ package Frey::Server; use Moose; - +extends 'Frey'; with 'Frey::Web'; +with 'Frey::Config'; use Continuity; #use Continuity::REPL; use Data::Dump qw/dump/; -use Carp::REPL; +#use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much use Frey::ClassLoader; +use Frey::Run; +use Frey::Editor; my @messages; # Global (shared) list of messages my $got_message; # Flag to indicate that there is a new message to display @@ -18,94 +21,158 @@ #$repl = Continuity::REPL->new; +=head1 NAME + +Frey::Server - Continuity based server for Frey + +=head2 DESCRIPTION + +This is one of pissible server implementations for Frey. In it's current stage, it's also most complete one. + +=head2 run + + $o->run( $optional_port ); + +=cut + sub run { my ( $self, $port ) = @_; $server = Continuity->new( - port => $port || 16001, + port => $port || $self->config->{port} || 16001, path_session => 1, cookie_session => 'sid', callback => \&main, - debug_level => 1, - staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ }, + debug_level => 2, + staticp => sub { + $_[0]->url =~ m{^/+(static|var).*\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$} + }, ); - $Module::Reload::Debug = 1; + $Module::Reload::Debug = 1; # auto if debug_level > 1 Frey::ClassLoader->new->load_all_classes(); $server->loop; } -# This is the main entrypoint. We are looking for one of three things -- a -# pushstream, a sent message, or a request for the main HTML. We delegate each -# of these cases, none of which will return (they all loop forever). +=head2 main + +This is simple dispatcher for our server. Currently it's in flux and +documented only in source code. + +=cut + sub main { my ($req) = @_; - - my $path = $req->request->url->path; - warn "REQUEST: $path ",dump( $req->params ),"\n"; - Module::Reload->check if $path =~ m!reload! || $req->param('reload'); +# $req->send_headers("X-Frey-VERSION: $Frey::VERSION"); -# warn $req->request->header('User_Agent'); + my $path = $req->request->url->path; - sub run_markup { - my ( $req, $class ) = @_; + eval { - my %params = $req->params; + if ( $path =~ m{/reload(.*)} ) { - my @required = - grep { - defined $_ && !defined( $params{$_} ) + $ENV{FREY_NO_LOG} = 1; + my $cmd = "perl -c $0"; + warn "# check config with $cmd"; + if ( system($cmd) == 0 ) { + $req->print( "\r\n" ); + my $server = Frey::Server->new; + $server->load_config; + $req->print( "\r\n" ); + Module::Reload->check; + $req->print( "\r\n" ); + $req->print( refresh( $1, 1 ) ); + $req->print( "\r\n" ); + warn "# reload done"; + return; + } else { + warn "ERROR: $?"; } - map { - my $attr = $class->meta->get_attribute($_); - $attr->is_required && $_ - } $class->meta->get_attribute_list; + $ENV{FREY_NO_LOG} = 0; + + } elsif ( $path =~ m{/exit(.*)} ) { + # FIXME do we need some kind of check here for production? :-) + # ./bin/dev.sh will restart us during development + $req->print( refresh( $1, 2 ) ); + $req->print( "\r\n" ); + exit; + } - warn "## required = ",dump( @required ); - warn "## params = ",dump( %params ); +# warn $req->request->header('User_Agent'); + my %params = $req->params; my $html; - if ( @required ) { - $html = qq|
|; - } else { - my $o = $class->new( %params ); - $o->depends if $o->can('depends'); - $html = $o->markup; + sub rest2class { + my $class = shift; + $class =~ s/-/::/; # sigh! + return $class; } - warn ">>> markup $class ",length( $html ), " bytes\n"; - return $html; - } + my $f; -# eval { - { + my $editor = Frey::Editor->new; - my $f; + # shared run params + my $run = { + request_url => $req->request->url, + debug => 1, + }; + + if ( + $path =~ m{/Frey[:-]+ObjectBrowser} + ) { + $f = Frey::ObjectBrowser->new( fey_class => $params{class} ); + $f->request( $req ); + } elsif ( + $path =~ m{/Frey[:-]+ObjectDesigner} + ) { + $f = Frey::ObjectDesigner->new( fey_class => $params{class} ); + $f->request( $req ); + } elsif ( $path =~ $editor->url_regex ) { + $req->print( $editor->command( $path ) ); + system( $editor->command( $path ) ); + return; + } elsif ( + $path =~ m{/([^/]+)/(\w*as_\w+)/?([^/]+)?} + ) { + my $class = rest2class $1; + warn "# run $path -> $class $2"; + $run->{format} = $3 if $3; + $params{request_url} = $req->request->url; + $req->print( "\r\n\r\n" ); # send something to browser so we don't time-out + $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run ); + } elsif ( + $path =~ m{/([^/]+)/?$} + ) { + my $class = rest2class $1; + warn "# introspect $class"; + $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run ); + } else { + $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run ); + } - if ( $path =~ m!/~/([^/]+)(.*)! ) { - $f = Frey::Introspect->new( package => $1 ); - } elsif ( $path =~ m!/ob/([^/]+)(.*)! ) { - $f = Frey::ObjectBrowser->new( fey_class => $1 ); - } elsif ( $path =~ m!/od/([^/]+)(.*)! ) { - $f = Frey::ObjectDesigner->new( fey_class => $1 ); - } elsif ( $path =~ m!/markup/([^/]+)(.*)! ) { - $req->print( run_markup( $req, $1 ) ); + if ( $f ) { + $f->clean_status; + $f->add_status( { request => $req } ); + $f->status_parts; + if ( my $html = $f->html ) { + warn "## html ",length($html)," bytes"; + $req->print( $html ); + } else { + $req->print( qq|no output from $f\r\n\r\n| ); + } } else { - $f = Frey::ClassBrowser->new; + warn "# can't call request on nothing!"; } - $f->html( $req ) if $f; }; if ( $@ ) { - warn $@; - #$req->conn->send_error( 404 ); # FIXME this should probably be 500, but we can't ship page with it - $req->print( qq{
$@} ); - Carp::REPL::repl; # FIXME if $self->debug - + warn "SERVER ERROR: $@"; +# $req->conn->send_error( 404 ); # FIXME this should probably be 500, but we can't ship page with it + $req->print( qq{$@\r\n\r\n} ); +# Carp::REPL::repl; } # If this is a request for the pushtream, then give them that @@ -113,15 +180,15 @@ pushstream($req); } - if ( $path =~ m/die/ ) { - Carp::REPL::repl; # FIXME if $self->debug - } - # If they are sending us a message, we give them a thread for that too if($path =~ /sendmessage/) { send_message($req); } + if ( $req->conn ) { + $req->conn->close; + warn "## close connection: $@"; + } } # Here we accept a connection to the browser, and keep it open. Meanwhile we @@ -161,4 +228,22 @@ } } +sub refresh { + my ( $url, $time ) = @_; + $url ||= '/'; + $time ||= 1; + warn "# refresh $url"; + qq| + + + + + + Refresh $url in $time sec + + + \n\r\n\r + |; # XXX newlines at end are important to flush content to browser +} + 1;