/[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 118 by dpavlin, Sun Jul 13 18:14:07 2008 UTC revision 184 by dpavlin, Tue Sep 9 23:15:46 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;
12  use Frey::ClassLoader;  use Frey::ClassLoader;
13    
14  my @messages;    # Global (shared) list of messages  my @messages;    # Global (shared) list of messages
# Line 18  use vars qw( $repl $server ); Line 18  use vars qw( $repl $server );
18    
19  #$repl = Continuity::REPL->new;  #$repl = Continuity::REPL->new;
20    
21    =head1 NAME
22    
23    Frey::Server - Continuity based server for Frey
24    
25    =head2 DESCRIPTION
26    
27    This is one of pissible server implementations for Frey. In it's current stage, it's also most complete one.
28    
29    =head2 run
30    
31      $o->run( $optional_port );
32    
33    =cut
34    
35  sub run {  sub run {
36          my ( $self, $port ) = @_;          my ( $self, $port ) = @_;
37          $server = Continuity->new(          $server = Continuity->new(
# Line 26  sub run { Line 40  sub run {
40                  cookie_session => 'sid',                  cookie_session => 'sid',
41                  callback => \&main,                  callback => \&main,
42                  debug_level => 1,                  debug_level => 1,
43                  staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?)$/ },                  staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },
44          );          );
45          $Module::Reload::Debug = 1;          $Module::Reload::Debug = 1;
46          Frey::ClassLoader->new->load_all_classes();          Frey::ClassLoader->new->load_all_classes();
47          $server->loop;          $server->loop;
48  }  }
49    
50  # This is the main entrypoint. We are looking for one of three things -- a  =head2 main
51  # pushstream, a sent message, or a request for the main HTML. We delegate each  
52  # 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
53    documented only in source code.
54    
55    =cut
56    
57  sub main {  sub main {
58          my ($req) = @_;          my ($req) = @_;
59        
60          my $path = $req->request->url->path;          my $path = $req->request->url->path;
61          warn "REQUEST: $path\n";          warn "REQUEST: $path ",dump( $req->params ),"\n";
62    
63          warn $req->request->header('User_Agent');          Module::Reload->check if $path =~ m!reload! || $req->param('reload');
 #warn dump( $req );  
64    
65          eval {  #       warn $req->request->header('User_Agent');
66    
67    #       eval {
68            {
69    
70                  my $f;                  my $f;
71    
# Line 55  sub main { Line 75  sub main {
75                          $f = Frey::ObjectBrowser->new( fey_class => $1 );                          $f = Frey::ObjectBrowser->new( fey_class => $1 );
76                  } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {                  } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {
77                          $f = Frey::ObjectDesigner->new( fey_class => $1 );                          $f = Frey::ObjectDesigner->new( fey_class => $1 );
78                    } elsif ( $path =~ m!/(markup|html)/([^/]+)(.*)! ) {
79                            $f = Frey::Run->new( class => $2 );
80                    } else {
81                            $f = Frey::ClassBrowser->new;
82                  }                  }
83                  $f->html( $req ) if $f;                  $f->html( $req ) if $f;
84    
# Line 64  sub main { Line 88  sub main {
88                  warn $@;                  warn $@;
89                  #$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
90                  $req->print( qq{<pre class="error">$@<pre>} );                  $req->print( qq{<pre class="error">$@<pre>} );
91  #               Carp::REPL::repl;       # FIXME if $self->debug                  Carp::REPL::repl;       # FIXME if $self->debug
         } else {  
   
                 my $f = Frey::ClassLoader->new;  
                 my $classes = dom2html(  
                         table => [  
                                 map {  
                                         my $package = $_;  
                                         ( tr => [  
                                                 td => [ a => { href => '/~/' . $package, title => $f->package_path( $package ) } => [ $package ] ],  
                                                 td => [  
                                                         $package->can('meta') ?  
                                                                 $package->meta->isa('Moose::Meta::Role') ? 'role' :  
                                                                 ( a => { href => '/od/' . $package } => [ 'design' ] ) :  
                                                         ''  
                                                 ],  
                                                 td => [ $package->can('collection_table') ? ( a => { href => '/ob/' . $package } => [ 'collection' ] ) : '' ],  
                                         ] )  
                                 } $f->classes  
                         ],  
                 );  
                 $req->print( "<h1>Classes</h1>$classes" );  
92    
93          }          }
94    
# Line 93  sub main { Line 96  sub main {
96          if($path =~ /pushstream/) {          if($path =~ /pushstream/) {
97                  pushstream($req);                  pushstream($req);
98          }          }
99      
100            if ( $path =~ m/die/ ) {
101                    Carp::REPL::repl;       # FIXME if $self->debug
102            }
103    
104          # 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
105          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
106                  send_message($req);                  send_message($req);
Legend:
Removed from v.118  
changed lines
  Added in v.184
  ViewVC Help
Powered by ViewVC 1.1.26