--- trunk/lib/Frey/Server.pm 2008/07/05 19:00:10 55 +++ trunk/lib/Frey/Server.pm 2008/11/29 15:19:43 618 @@ -1,14 +1,18 @@ package Frey::Server; use Moose; +extends 'Frey'; +with 'Frey::Web'; +with 'Frey::Config'; use Continuity; #use Continuity::REPL; -use Continuity::Widget::DomNode; use Data::Dump qw/dump/; -use Frey; -use Frey::Introspect; +#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 @@ -16,50 +20,175 @@ use vars qw( $repl $server ); #$repl = Continuity::REPL->new; -$server = Continuity->new( - 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?)$/ }, -); + +=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 + +our $editor = Frey::Editor->new; sub run { + my ( $self, $port ) = @_; + $server = Continuity->new( + port => $port || $self->config->{port} || 16001, + path_session => 1, + cookie_session => 'sid', + callback => \&main, + 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; # auto if debug_level > 1 + Frey::ClassLoader->new->load_all_classes(); + $editor->switch_screen if $ENV{FREY_SWITCH_SCREEN}; $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) = @_; - + +# $req->send_headers("X-Frey-VERSION: $Frey::VERSION"); + my $path = $req->request->url->path; - warn "REQUEST: $path\n"; - warn $req->request->header('User_Agent'); -#warn dump( $req ); + eval { - if ( $path =~ m!/~/([^/]+)(?:/([^/]*))?! ) { - my $f = Frey::Introspect->new( package => $1 ); - $f->html( $req ); + if ( $path =~ m{/reload(.*)} ) { + + $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: $?"; + } + $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 $req->request->header('User_Agent'); + + my %params = $req->params; + my $html; + + sub rest2class { + my $class = shift; + $class =~ s/-/::/; # sigh! + return $class; + } + + + 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 ) ); + 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 ( $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 { + confess "no output from $f"; + } + } else { + confess "# can't call request on nothing!"; + } + + }; + + if ( $@ ) { + 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
 	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);
 	}
 
-	while ( 1 ) {
-		my $f = Frey->new;
-		$req->print( dump( $f->classes ) );
-		$req->next;
+	if ( $req->conn ) {
+		$req->print( "\r\n" ); # flush
+		$req->conn->close;
+		warn "## close connection: $@";
 	}
 }
 
@@ -100,4 +229,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;