/[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 56 by dpavlin, Sun Jul 6 11:59:58 2008 UTC revision 190 by dpavlin, Sun Sep 14 00:45:47 2008 UTC
# Line 2  package Frey::Server; Line 2  package Frey::Server;
2    
3  use Moose;  use Moose;
4    
5    with 'Frey::Web';
6    
7  use Continuity;  use Continuity;
8  #use Continuity::REPL;  #use Continuity::REPL;
 use Continuity::Widget::DomNode;  
9  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
10    
11  use Frey;  #use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much
12  use Frey::Introspect;  use Frey::ClassLoader;
13    
14  my @messages;    # Global (shared) list of messages  my @messages;    # Global (shared) list of messages
15  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 16  my $got_message; # Flag to indicate that Line 17  my $got_message; # Flag to indicate that
17  use vars qw( $repl $server );  use vars qw( $repl $server );
18    
19  #$repl = Continuity::REPL->new;  #$repl = Continuity::REPL->new;
20  $server = Continuity->new(  
21          port => 16001,  =head1 NAME
22          path_session => 1,  
23          cookie_session => 'sid',  Frey::Server - Continuity based server for Frey
24          callback => \&main,  
25          debug_level => 1,  =head2 DESCRIPTION
26          staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?)$/ },  
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 ) = @_;
37            $server = Continuity->new(
38                    port => $port || 16001,
39                    path_session => 1,
40                    cookie_session => 'sid',
41                    callback => \&main,
42                    debug_level => 1,
43                    staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },
44            );
45            $Module::Reload::Debug = 1;
46            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            Module::Reload->check if $path =~ m!reload! || $req->param('reload');
64    
65          warn $req->request->header('User_Agent');  #       warn $req->request->header('User_Agent');
66  #warn dump( $req );  
67    #       eval {
68            {
69    
70                    my $f;
71    
72                    if ( $path =~ m!/~/([^/]+)(.*)! ) {
73                            $f = Frey::Introspect->new( package => $1 );
74                    } elsif ( $path =~ m!/ob/([^/]+)(.*)! ) {
75                            $f = Frey::ObjectBrowser->new( fey_class => $1 );
76                    } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {
77                            $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;
84    
85            };
86    
87            my $self = $req;
88    
89            if ( $@ ) {
90                    warn $@;
91                    #$req->conn->send_error( 404 ); # FIXME this should probably be 500, but we can't ship page with it
92                    $req->print( qq{<pre class="error">$@<pre>} );
93    #               Carp::REPL::repl;
94    
         if ( $path =~ m!/~/([^/]+)(?:/([^/]*))?! ) {  
                 my $f = Frey::Introspect->new( package => $1 );  
                 $f->html( $req );  
95          }          }
96    
97          # If this is a request for the pushtream, then give them that          # If this is a request for the pushtream, then give them that
98          if($path =~ /pushstream/) {          if($path =~ /pushstream/) {
99                  pushstream($req);                  pushstream($req);
100          }          }
101      
102          # 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
103          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
104                  send_message($req);                  send_message($req);
105          }          }
106    
         while ( 1 ) {  
                 my $f = Frey->new;  
                 my $classes = Continuity::Widget::DomNode->create(  
                         ul => [  
                                 map {  
                                         warn dump( $_ );  
                                         my ( $package, $path ) = %$_;  
                                         ( li => [ a => { href => '/~/' . $package . '/' } => [ $package ], " <tt>$path</tt>" ] )  
                                 } @{ $f->classes }  
                         ],  
                 )->to_string;  
                 $req->print( $classes );  
                 $req->next;  
         }  
107  }  }
108    
109  # Here we accept a connection to the browser, and keep it open. Meanwhile we  # Here we accept a connection to the browser, and keep it open. Meanwhile we
Legend:
Removed from v.56  
changed lines
  Added in v.190
  ViewVC Help
Powered by ViewVC 1.1.26