/[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!
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 162 by dpavlin, Thu Jul 17 21:07:16 2008 UTC revision 429 by dpavlin, Tue Nov 18 23:57:56 2008 UTC
# Line 1  Line 1 
1  package Frey::Server;  package Frey::Server;
2    
3  use Moose;  use Moose;
4    extends 'Frey';
5  with 'Frey::Web';  with 'Frey::Web';
6    with 'Frey::Config';
7    
8  use Continuity;  use Continuity;
9  #use Continuity::REPL;  #use Continuity::REPL;
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11    
12  use Carp::REPL;  #use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much
13  use Frey::ClassLoader;  use Frey::ClassLoader;
14    use Frey::Run;
15    use Frey::Editor;
16    
17  my @messages;    # Global (shared) list of messages  my @messages;    # Global (shared) list of messages
18  my $got_message; # Flag to indicate that there is a new message to display  my $got_message; # Flag to indicate that there is a new message to display
# Line 18  use vars qw( $repl $server ); Line 21  use vars qw( $repl $server );
21    
22  #$repl = Continuity::REPL->new;  #$repl = Continuity::REPL->new;
23    
24    =head1 NAME
25    
26    Frey::Server - Continuity based server for Frey
27    
28    =head2 DESCRIPTION
29    
30    This is one of pissible server implementations for Frey. In it's current stage, it's also most complete one.
31    
32    =head2 run
33    
34      $o->run( $optional_port );
35    
36    =cut
37    
38  sub run {  sub run {
39          my ( $self, $port ) = @_;          my ( $self, $port ) = @_;
40          $server = Continuity->new(          $server = Continuity->new(
41                  port => $port || 16001,                  port => $port || $self->config->{port} || 16001,
42                  path_session => 1,                  path_session => 1,
43                  cookie_session => 'sid',                  cookie_session => 'sid',
44                  callback => \&main,                  callback => \&main,
45                  debug_level => 1,                  debug_level => 2,
46                  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)(\?.*)?$/ },
47          );          );
48          $Module::Reload::Debug = 1;          $Module::Reload::Debug = 1; # auto if debug_level > 1
49          Frey::ClassLoader->new->load_all_classes();          Frey::ClassLoader->new->load_all_classes();
50          $server->loop;          $server->loop;
51  }  }
52    
53  # This is the main entrypoint. We are looking for one of three things -- a  =head2 main
54  # pushstream, a sent message, or a request for the main HTML. We delegate each  
55  # of these cases, none of which will return (they all loop forever).  This is simple dispatcher for our server. Currently it's in flux and
56    documented only in source code.
57    
58    =cut
59    
60  sub main {  sub main {
61          my ($req) = @_;          my ($req) = @_;
62      
63          my $path = $req->request->url->path;          my $path = $req->request->url->path;
         warn "REQUEST: $path ",dump( $req->params ),"\n";  
64    
65          Module::Reload->check if $path =~ m!reload! || $req->param('reload');          eval {
66    
67  #       warn $req->request->header('User_Agent');                  #warn "REQUEST: $path ",dump( $req->params );
68    
69                    if ( $path =~ m!reload! || $req->param('reload') ) {
70                            warn "# reload!";
71                            Module::Reload->check;
72                            Frey::Server->new->load_config;
73                    }
74    
75    #               warn $req->request->header('User_Agent');
76    
77                    my %params = $req->params;
78                    my $html;
79    
80                    sub rest2class {
81                            my $class = shift;
82                            $class =~ s/-/::/; # sigh!
83                            return $class;
84                    }
85    
 #       eval {  
         {  
86    
87                  my $f;                  my $f;
88    
89                  if ( $path =~ m!/~/([^/]+)(.*)! ) {                  my $run_regexp = join('|', Frey::Run->runnable );
90                          $f = Frey::Introspect->new( package => $1 );                  my $editor = Frey::Editor->new;
91                  } elsif ( $path =~ m!/ob/([^/]+)(.*)! ) {  
92                          $f = Frey::ObjectBrowser->new( fey_class => $1 );                  # shared run params
93                  } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {                  my $run = {
94                          $f = Frey::ObjectDesigner->new( fey_class => $1 );                          request_url => $req->request->url,
95                  } elsif ( $path =~ m!/pod/([^/]+)(.*)! ) {                  };
96                          $f = Frey::Pod->new( class => $1 );  
97                  } elsif ( $path =~ m!/markup/([^/]+)(.*)! ) {                  if (
98                          my $o = $1->new( $req->params );                          $path =~ m{/Frey[:-]+ObjectBrowser}
99                          $o->depends if $o->can('depends');                  ) {
100                          my $html = $o->markup( $req->params );                          $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
101                          warn ">>> markup $1 ",length( $html ), " bytes\n";                          $f->request( $req );
102                          $req->print( $html );                  } elsif (
103                            $path =~ m{/Frey[:-]+ObjectDesigner}
104                    ) {
105                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
106                            $f->request( $req );
107                    } elsif ( $path =~ $editor->url_regex ) {
108                            $req->print( $editor->command( $path ) );
109                            system( $editor->command( $path ) );
110                            return;
111                    } elsif (
112                            $path =~ m{/([^/]+)/($run_regexp)/?([^/]+)?}
113                    ) {
114                            my $class = rest2class $1;
115                            warn "# run $path -> $class $2";
116                            $run->{format} = $3 if $3;
117                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run );
118                    } elsif (
119                            $path =~ m{/([^/]+)/?$}
120                    ) {
121                            my $class = rest2class $1;
122                            warn "# introspect $class";
123                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run );
124                  } else {                  } else {
125                          $f = Frey::ClassBrowser->new;                          $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
126                    }
127    
128                    if ( $f ) {
129                            $req->print( $f->html );
130                    } else {
131                            warn "# can't call request on nothing!";
132                  }                  }
                 $f->html( $req ) if $f;  
133    
134          };          };
135    
136          if ( $@ ) {          if ( $@ ) {
137                  warn $@;                  warn $@;
138                  #$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
139                  $req->print( qq{<pre class="error">$@<pre>} );                  $req->print( qq{<pre class="frey-error">$@<pre>} );
140                  Carp::REPL::repl;       # FIXME if $self->debug  #               Carp::REPL::repl;
   
141          }          }
142    
143          # If this is a request for the pushtream, then give them that          # If this is a request for the pushtream, then give them that
# Line 85  sub main { Line 145  sub main {
145                  pushstream($req);                  pushstream($req);
146          }          }
147    
         if ( $path =~ m/die/ ) {  
                 Carp::REPL::repl;       # FIXME if $self->debug  
         }  
   
148          # If they are sending us a message, we give them a thread for that too          # If they are sending us a message, we give them a thread for that too
149          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
150                  send_message($req);                  send_message($req);
Legend:
Removed from v.162  
changed lines
  Added in v.429
  ViewVC Help
Powered by ViewVC 1.1.26