--- trunk/lib/Frey/Server.pm 2008/11/18 00:55:23 392 +++ trunk/lib/Frey/Server.pm 2008/11/30 01:32:56 632 @@ -1,188 +1,173 @@ package Frey::Server; use Moose; -extends 'Frey'; -with 'Frey::Web'; +extends 'Frey::Editor'; 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 +has 'port' => ( + documentation => 'port on which server listen', + is => 'ro', + isa => 'Int', + default => sub { + my $self = shift; + $ENV{FREY_PORT} || $self->config->{port} || 16001 + }, +); + +has 'editor' => ( + is => 'ro', + isa => 'Frey::Editor', + lazy => 1, + default => sub { + Frey::Editor->new; + }, +); -use vars qw( $repl $server ); - -#$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 || $self->config->{port} || 16001, - path_session => 1, - cookie_session => 'sid', - callback => \&main, - 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; -} - -=head2 main +=head2 request This is simple dispatcher for our server. Currently it's in flux and documented only in source code. =cut -sub main { - my ($req) = @_; +sub print { + my $self = shift; + warn "# print ", join(' ', map { length $_ } @_ ); + $self->{_print}->( @_ ); +} - my $path = $req->request->url->path; - #warn "REQUEST: $path ",dump( $req->params ); +sub request { + my ( $self, $url, $params ) = @_; - Module::Reload->check if $path =~ m!reload! || $req->param('reload'); + if ( my $ref = ref($url) ) { + die "url not URI but ", dump( $url ) unless $ref =~ m{^URI}; + } else { + $url = URI->new($url); + } -# warn $req->request->header('User_Agent'); + my $path = $url->path; - my %params = $req->params; - my $html; +# eval { + { - sub rest2class { - my $class = shift; - $class =~ s/-/::/; # sigh! - return $class; - } + if ( $path =~ m{/reload(.*)} ) { + $ENV{FREY_NO_LOG} = 1; + my $cmd = "perl -c $0"; + warn "# check syntax with $cmd"; + if ( system($cmd) == 0 ) { + my $server = Frey::Server->new; + $self->load_config; + Module::Reload->check; + warn "# reload done"; + $self->print( refresh( $1, 1 ) ); + 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 + $self->print( refresh( $1, 2 ) ); + exit; + } + + my $html; - eval { + sub rest2class { + my $class = shift; + $class =~ s/-/::/; # sigh! + return $class; + } my $f; - my $run_regexp = join('|', Frey::Run->runnable ); + # shared run params + my $run = { + request_url => $url, +# debug => 1, + }; if ( $path =~ m{/Frey[:-]+ObjectBrowser} ) { - $f = Frey::ObjectBrowser->new( fey_class => $params{class} ); - $f->request( $req ); + $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 ); + $f = Frey::ObjectDesigner->new( fey_class => $params->{class} ); +# $f->request( $req ); + } elsif ( $path =~ $self->editor->url_regex ) { + $self->print( $self->editor->command( $path ) ); return; } elsif ( - $path =~ m{/([^/]+)/($run_regexp)} + $path =~ m{/([^/]+)/(\w*as_\w+)/?([^/]+)?} ) { my $class = rest2class $1; - warn "# run $class $2\n"; - $f = Frey::Run->new( class => $class, params => \%params, run => $2, request_url => $req->request->url ); + warn "# run $path -> $class $2"; + $run->{format} = $3 if $3; + $params->{request_url} = $url, + $run->{$_} = $params->{$_} foreach keys %$params; + $f = Frey::Run->new( class => $class, params => $run, run => $2, request_url => $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 ); + $run->{class} ||= $class; + $f = Frey::Run->new( class => 'Frey::Introspect', params => $run, request_url => $url ); } else { - $f = Frey::Run->new( class => 'Frey::ClassBrowser' ); + $f = Frey::Run->new( class => 'Frey::ClassBrowser', params => $run, request_url => $url ); } if ( $f ) { - $req->print( $f->html ); + $f->clean_status; +# $f->add_status( { request => $req } ); + $f->status_parts; + if ( my $html = $f->html ) { + warn "## html ",length($html)," bytes"; + $self->print( $html ); + } else { + confess "no output from $f"; + } } else { - warn "# can't call request on nothing!"; + confess "# 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{
$@
} );
+		warn "SERVER ERROR: $@";
+#		$req->conn->send_error( 404 );	# FIXME this should probably be 500, but we can't ship page with it
+		$self->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);
 	}
 
 }
 
-# Here we accept a connection to the browser, and keep it open. Meanwhile we
-# watch the global $got_message variable, and when it gets touched we send off
-# the list of messages through the held-open connection. Then we let the
-# browser open a new connection and begin again.
-sub pushstream {
-  my ($req) = @_;
-  # Set up watch event -- this will be triggered when $got_message is written
-  my $w = Coro::Event->var(var => \$got_message, poll => 'w');
-  while(1) {
-    print STDERR "**** GOT MESSAGE, SENDING ****\n";
-    my $log = join "
", @messages;
-    $req->print($log);
-    $req->next;
-    print STDERR "**** Waiting for got_message indicator ****\n";
-    $w->next;
-  }
-}
-
-
-# Watch for the user to send us a message. As soon as we get it, we add it to
-# our list of messages and touch the $got_message flag to let all the
-# pushstreams know.
-sub send_message {
-  my ($req) = @_;
-  while(1) {
-    my $msg = $req->param('message');
-    my $name = $req->param('username');
-    if($msg) {
-      unshift @messages, "$name: $msg";
-      pop @messages if $#messages > 15; # Only keep the recent 15 messages
-    }
-    $got_message = 1;
-    $req->print("Got it!");
-    $req->next;
-  }
+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;