--- trunk/lib/Frey/Server.pm 2008/07/14 21:22:43 121 +++ trunk/lib/Frey/Server.pm 2008/11/15 16:29:26 346 @@ -1,15 +1,17 @@ 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; my @messages; # Global (shared) list of messages my $got_message; # Flag to indicate that there is a new message to display @@ -18,57 +20,118 @@ #$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?)$/ }, + debug_level => 2, + staticp => sub { $_[0]->url =~ m/\.(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\n"; + #warn "REQUEST: $path ",dump( $req->params ); - Module::Reload->check if $path =~ m!reload!; + Module::Reload->check if $path =~ m!reload! || $req->param('reload'); + +# warn $req->request->header('User_Agent'); + + my %params = $req->params; + my $html; + + sub rest2class { + my $class = shift; + $class =~ s/-/::/; # sigh! + return $class; + } - warn $req->request->header('User_Agent'); -#warn dump( $req ); eval { my $f; - 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 ); + my $run_regexp = join('|', Frey::Run->runnable ); + + 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 =~ m{/editor(.+?)\+(\d+)} + ) { + my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi'; + my $cmd = "$editor -R +$2 $1"; + warn "# $path -> system $cmd"; + $req->print( $cmd ); + system( $cmd ); + return; + } elsif ( + $path =~ m{/([^/]+)/($run_regexp)} + ) { + my $class = rest2class $1; + warn "# run $class $2\n"; + $f = Frey::Run->new( class => $class, params => \%params ); + } elsif ( + $path =~ m{/([^/]+)/?$} + ) { + my $class = rest2class $1; + warn "# introspect $class"; + $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class } ); } else { - $f = Frey::ClassBrowser->new; + $f = Frey::Run->new( class => 'Frey::ClassBrowser' ); + } + + if ( $f ) { + $req->print( $f->html ); + } else { + warn "# can't call request on nothing!"; } - $f->html( $req ) if $f; }; + my $self = $req; + if ( $@ ) { warn $@; - #$req->conn->send_error( 404 ); # FIXME this should probably be 500, but we can't ship page with it + $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
+#		Carp::REPL::repl;
 
 	}
 
@@ -77,10 +140,6 @@
 		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);