--- trunk/lib/Frey/Server.pm 2008/07/11 23:08:25 103 +++ trunk/lib/Frey/Server.pm 2008/11/18 00:55:23 392 @@ -1,14 +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; ## 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 @@ -17,69 +20,119 @@ #$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; # 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! || $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 { - if ( $path =~ m!/~/([^/]+)(?:/([^/]*))?! ) { - my $f = Frey::Introspect->new( package => $1 ); - $f->html( $req ); + my $f; + + 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'; + # FIXME SECURITY path verification for $1 + my $cmd = "$editor +$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, run => $2, request_url => $req->request->url ); + } elsif ( + $path =~ m{/([^/]+)/?$} + ) { + my $class = rest2class $1; + warn "# introspect $class"; + $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, request_url => $req->request->url ); + } else { + $f = Frey::Run->new( class => 'Frey::ClassBrowser' ); } - if ( $path =~ m!/ob/([^/]+)(?:/([^/]*))?! ) { - my $f = Frey::ObjectBrowser->new( fey_class => $1 ); - $f->html( $req ); + if ( $f ) { + $req->print( $f->html ); + } else { + warn "# can't call request on nothing!"; } }; + 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{
$@
} );
-
-	} else {
-
-		my $f = Frey::ClassLoader->new;
-		my $classes = dom2html(
-			ul => [
-				map {
-					warn dump( $_ );
-					my $package = $_;
-					( li => [
-						a => { href => '/~/' . $package . '/' } => [ $package ],
-						' ', $f->package_path( $package ), ' ',
-						$package->can('rows') ?
-							( a => { href => '/ob/' . $package } => [ 'browse' ] ) : '',
-					] )
-				} $f->classes
-			],
-		);
-		$req->print( $classes );
+		$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;
 
 	}
 
@@ -87,7 +140,7 @@
 	if($path =~ /pushstream/) {
 		pushstream($req);
 	}
-  
+
 	# If they are sending us a message, we give them a thread for that too
 	if($path =~ /sendmessage/) {
 		send_message($req);