--- trunk/lib/Frey/Server.pm 2008/07/17 18:00:55 158 +++ trunk/lib/Frey/Server.pm 2008/11/16 00:37:34 350 @@ -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,65 +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 ",dump( $req->params ),"\n"; + #warn "REQUEST: $path ",dump( $req->params ); Module::Reload->check if $path =~ m!reload! || $req->param('reload'); # warn $req->request->header('User_Agent'); -# eval { - { + my %params = $req->params; + my $html; + + sub rest2class { + my $class = shift; + $class =~ s/-/::/; # sigh! + return $class; + } + + + 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 ); - } elsif ( $path =~ m!/pod/([^/]+)(.*)! ) { - $f = Frey::Pod->new( class => $1 ); - } elsif ( $path =~ m!/markup/([^/]+)(.*)! ) { - my $o = $1->new( $req->params ); - $o->depends if $o->can('depends'); - my $html = $o->markup( $req->params ); - warn ">>> markup $1 ",length( $html ), " bytes\n"; - $req->print( $html ); + 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->print( qq{
$@
} );
-		Carp::REPL::repl;	# FIXME if $self->debug
+		$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;
 
 	}
 
@@ -85,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);