--- trunk/lib/Frey/Server.pm 2008/07/13 17:41:13 114 +++ trunk/lib/Frey/Server.pm 2008/11/20 13:57:38 477 @@ -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,78 +21,151 @@ #$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/^(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\n"; - warn $req->request->header('User_Agent'); -#warn dump( $req ); + my $path = $req->request->url->path; eval { + sub refresh { + my $url = shift || '/'; + warn "# refresh $url"; + qq| + + + + + + Refresh $url + + + \n\r\n\r + |; # XXX newlines at end are important to flush content to browser + } + + if ( $path =~ m{/reload(.*)} ) { + Frey::Server->new->load_config; + Module::Reload->check; + warn "# reload done"; + $req->print( refresh( $1 ) ); + return; + } 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 ) ); + exit; + } + +# warn $req->request->header('User_Agent'); + + my %params = $req->params; + my $html; + + sub rest2class { + my $class = shift; + $class =~ s/-/::/; # sigh! + return $class; + } + + 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 $editor = Frey::Editor->new; + + # shared run params + my $run = { + request_url => $req->request->url, + }; + + 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{/([^/]+)/(as_\w+)/?([^/]+)?} + ) { + my $class = rest2class $1; + warn "# run $path -> $class $2"; + $run->{format} = $3 if $3; + $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 ( $f ) { + push @{ $f->status }, { req => $req }; + $req->print( $f->html ); + } else { + 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
-	} else {
-
-		my $f = Frey::ClassLoader->new;
-		my $classes = dom2html(
-			table => [
-				map {
-					warn dump( $_ );
-					my $package = $_;
-					( tr => [
-						td => [ a => { href => '/~/' . $package, title => $f->package_path( $package ) } => [ $package ] ],
-						td => [ $package->can('meta') ? ( a => { href => '/od/' . $package } => [ 'design' ] ) : '' ],
-						td => [ $package->can('collection') ? ( a => { href => '/ob/' . $package } => [ 'collection' ] ) : '' ],
-					] )
-				} $f->classes
-			],
-		);
-		$req->print( "

Classes

$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;
 	}
 
 	# If this is a request for the pushtream, then give them that
 	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);