/[Frey]/trunk/lib/Frey/Server.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /trunk/lib/Frey/Server.pm

Parent Directory | Revision Log | View Patch Patch

-revision 205 by dpavlin,
Thu Oct 30 22:34:40 2008 UTC
+revision 523 by dpavlin,
Wed Nov 26 00:16:30 2008 UTC
 Line 1
  package Frey::Server;
  use Moose;
+ extends 'Frey';
  with 'Frey::Web';
+ with 'Frey::Config';
  use Continuity;
  #use Continuity::REPL;
-Line 10 
 use Data::Dump qw/dump/;
+Line 11 
 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;
+ use Frey::Editor;
  my @messages;    # Global (shared) list of messages
  my $got_message; # Flag to indicate that there is a new message to display
-Line 35 
 This is one of pissible server implement
+Line 38 
 This is one of pissible server implement
  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 => 2,
-                 staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },
+                 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();
-Line 58 
 sub main {
+Line 63 
 sub main {
          my ($req) = @_;
          my $path = $req->request->url->path;
-         warn "REQUEST: $path ",dump( $req->params ),"\n";
-         Module::Reload->check if $path =~ m!reload! || $req->param('reload');
+         eval {
+                 sub refresh {
+                         my $url = shift || '/';
+                         warn "# refresh $url";
+                         qq|
+                                 <html>
+                                 <head>
+                                         <META HTTP-EQUIV="Refresh" CONTENT="2; URL=$url"></META>
+                                 </head>
+                                 <body>
+                                         Refresh <a href="$url"><tt>$url</tt></a>
+                                 </body>
+                                 </html>
+                                 \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');
- #       warn $req->request->header('User_Agent');
+                 my %params = $req->params;
+                 my $html;
+                 sub rest2class {
+                         my $class = shift;
+                         $class =~ s/-/::/; # sigh!
+                         return $class;
+                 }
- #       eval {
-         {
                  my $f;
-                 if ( $path =~ m!/~/([^/]+)(.*)! ) {
+                 my $editor = Frey::Editor->new;
-                         $f = Frey::Introspect->new( package => $1 );
-                 } elsif ( $path =~ m!/ob/([^/]+)(.*)! ) {
+                 # shared run params
-                         $f = Frey::ObjectBrowser->new( fey_class => $1 );
+                 my $run = {
-                 } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {
+                         request_url => $req->request->url,
-                         $f = Frey::ObjectDesigner->new( fey_class => $1 );
+                         debug => 1,
-                 } elsif ( $path =~ m!/(markup|html)/([^/]+)(.*)! ) {
+                 };
-                         $f = Frey::Run->new( class => $2 );
+                 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;
+                         $params{request_url} = $req->request->url;
+                         $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::ClassBrowser->new;
+                         $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
                  }
-                 $f->html( $req ) if $f;
-         };
+                 if ( $f ) {
+                         $f->clean_status;
+                         $f->add_status( { request => $req } );
+                         warn "## status ", dump( map { keys %$_ } $f->status );
+                         my $html = $f->html;
+                         die "no html output" unless $html;
+                         warn "## html ",length($html)," bytes";
+                         $req->print( "$html\n" );
+                 } 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->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it
-                 $req->print( qq{<pre class="error">$@<pre>} );
+                 $req->print( qq{<pre class="frey-error">$@<pre>} );
  #               Carp::REPL::repl;
          }
          # If this is a request for the pushtream, then give them that
-Line 104 
 sub main {
+Line 180 
 sub main {
                  send_message($req);
          }
+         if ($req->conn ) {
+                 $req->conn->close;
+                 warn "## close connection: $@";
+         }
  }
  # Here we accept a connection to the browser, and keep it open. Meanwhile we

 Legend:



Removed from v.205
 


changed lines


 
Added in v.523
 Legend:



Removed from v.205
 


changed lines


 
Added in v.523
-Removed from v.205
+Added in v.523

	ViewVC Help
Powered by ViewVC 1.1.26