/[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 292 by dpavlin, Wed Nov 5 08:21:03 2008 UTC
# Line 8  use Continuity; Line 8  use Continuity;
8  #use Continuity::REPL;  #use Continuity::REPL;
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10    
11  use Carp::REPL;  #use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much
12  use Frey::ClassLoader;  use Frey::ClassLoader;
13    use Frey::Run;
14    
15  my @messages;    # Global (shared) list of messages  my @messages;    # Global (shared) list of messages
16  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 19  use vars qw( $repl $server );
19    
20  #$repl = Continuity::REPL->new;  #$repl = Continuity::REPL->new;
21    
22    =head1 NAME
23    
24    Frey::Server - Continuity based server for Frey
25    
26    =head2 DESCRIPTION
27    
28    This is one of pissible server implementations for Frey. In it's current stage, it's also most complete one.
29    
30    =head2 run
31    
32      $o->run( $optional_port );
33    
34    =cut
35    
36  sub run {  sub run {
37          my ( $self, $port ) = @_;          my ( $self, $port ) = @_;
38          $server = Continuity->new(          $server = Continuity->new(
# Line 25  sub run { Line 40  sub run {
40                  path_session => 1,                  path_session => 1,
41                  cookie_session => 'sid',                  cookie_session => 'sid',
42                  callback => \&main,                  callback => \&main,
43                  debug_level => 1,                  debug_level => 2,
44                  staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },                  staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },
45          );          );
46          $Module::Reload::Debug = 1;          $Module::Reload::Debug = 1; # auto if debug_level > 1
47          Frey::ClassLoader->new->load_all_classes();          Frey::ClassLoader->new->load_all_classes();
48          $server->loop;          $server->loop;
49  }  }
50    
51  # This is the main entrypoint. We are looking for one of three things -- a  =head2 main
52  # pushstream, a sent message, or a request for the main HTML. We delegate each  
53  # 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
54    documented only in source code.
55    
56    =cut
57    
58  sub main {  sub main {
59          my ($req) = @_;          my ($req) = @_;
60      
61          my $path = $req->request->url->path;          my $path = $req->request->url->path;
62          warn "REQUEST: $path ",dump( $req->params ),"\n";          #warn "REQUEST: $path ",dump( $req->params );
63    
64          Module::Reload->check if $path =~ m!reload! || $req->param('reload');          Module::Reload->check if $path =~ m!reload! || $req->param('reload');
65    
66  #       warn $req->request->header('User_Agent');  #       warn $req->request->header('User_Agent');
67    
68  #       eval {          my %params = $req->params;
69          {          my $html;
70    
71            sub rest2class {
72                    my $class = shift;
73                    $class =~ s/-/::/; # sigh!
74                    return $class;
75            }
76    
77    
78            eval {
79    
80                  my $f;                  my $f;
81    
82                  if ( $path =~ m!/~/([^/]+)(.*)! ) {                  my $run_regexp = join('|', Frey::Run->execute );
83                          $f = Frey::Introspect->new( package => $1 );  
84                  } elsif ( $path =~ m!/ob/([^/]+)(.*)! ) {                  if (
85                          $f = Frey::ObjectBrowser->new( fey_class => $1 );                          $path =~ m{/Frey[:-]+ObjectBrowser}
86                  } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {                  ) {
87                          $f = Frey::ObjectDesigner->new( fey_class => $1 );                          $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
88                  } elsif ( $path =~ m!/pod/([^/]+)(.*)! ) {                          $f->request( $req );
89                          $f = Frey::Pod->new( class => $1 );                  } elsif (
90                  } elsif ( $path =~ m!/markup/([^/]+)(.*)! ) {                          $path =~ m{/Frey[:-]+ObjectDesigner}
91                          my $o = $1->new( $req->params );                  ) {
92                          $o->depends if $o->can('depends');                          $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
93                          my $html = $o->markup( $req->params );                          $f->request( $req );
94                          warn ">>> markup $1 ",length( $html ), " bytes\n";                  } elsif (
95                          $req->print( $html );                          $path =~ m{/([^/]+)/($run_regexp)}
96                    ) {
97                            my $class = rest2class $1;
98                            warn "# run $class $2\n";
99                            $f = Frey::Run->new( class => $class, params => \%params );
100                    } elsif (
101                            $path =~ m{/([^/]+)/?$}
102                    ) {
103                            my $class = rest2class $1;
104                            warn "# introspect $class";
105                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class } );
106                  } else {                  } else {
107                          $f = Frey::ClassBrowser->new;                          $f = Frey::Run->new( class => 'Frey::ClassBrowser' );
108                    }
109    
110                    if ( $f ) {
111                            $req->print( $f->html );
112                    } else {
113                            warn "# can't call request on nothing!";
114                  }                  }
                 $f->html( $req ) if $f;  
115    
116          };          };
117    
118            my $self = $req;
119    
120          if ( $@ ) {          if ( $@ ) {
121                  warn $@;                  warn $@;
122                  #$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
123                  $req->print( qq{<pre class="error">$@<pre>} );                  $req->print( qq{<pre class="error">$@<pre>} );
124                  Carp::REPL::repl;       # FIXME if $self->debug  #               Carp::REPL::repl;
125    
126          }          }
127    
# Line 85  sub main { Line 130  sub main {
130                  pushstream($req);                  pushstream($req);
131          }          }
132    
         if ( $path =~ m/die/ ) {  
                 Carp::REPL::repl;       # FIXME if $self->debug  
         }  
   
133          # 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
134          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
135                  send_message($req);                  send_message($req);
Legend:
Removed from v.162  
changed lines
  Added in v.292
  ViewVC Help
Powered by ViewVC 1.1.26