/[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 64 by dpavlin, Tue Jul 8 16:18:13 2008 UTC revision 571 by dpavlin, Thu Nov 27 22:29:01 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';
6    with 'Frey::Config';
7    
8  use Continuity;  use Continuity;
9  #use Continuity::REPL;  #use Continuity::REPL;
 use Continuity::Widget::DomNode;  
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11    
12  use Frey;  #use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much
13  use Frey::Introspect;  use Frey::ClassLoader;
14  use Frey::ObjectBrowser;  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 ) = @_;
40          $server = Continuity->new(          $server = Continuity->new(
41                  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?)$/ },                  staticp => sub {
47                            $_[0]->url =~ m{^/+(static|var).*\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$}
48                    },
49          );          );
50            $Module::Reload::Debug = 1; # auto if debug_level > 1
51            Frey::ClassLoader->new->load_all_classes();
52          $server->loop;          $server->loop;
53  }  }
54    
55  # This is the main entrypoint. We are looking for one of three things -- a  =head2 main
56  # pushstream, a sent message, or a request for the main HTML. We delegate each  
57  # 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
58    documented only in source code.
59    
60    =cut
61    
62  sub main {  sub main {
63          my ($req) = @_;          my ($req) = @_;
64      
65    #       $req->send_headers("X-Frey-VERSION: $Frey::VERSION");
66    
67          my $path = $req->request->url->path;          my $path = $req->request->url->path;
         warn "REQUEST: $path\n";  
68    
69          warn $req->request->header('User_Agent');          eval {
 #warn dump( $req );  
70    
71          if ( $path =~ m!/~/([^/]+)(?:/([^/]*))?! ) {                  sub refresh {
72                  my $f = Frey::Introspect->new( package => $1 );                          my ( $url, $time ) = @_;
73                  $f->html( $req );                          $url  ||= '/';
74                            $time ||= 1;
75                            warn "# refresh $url";
76                            qq|
77                                    <html>
78                                    <head>
79                                            <META HTTP-EQUIV="Refresh" CONTENT="$time; URL=$url"></META>
80                                    </head>
81                                    <body>
82                                            Refresh <a href="$url"><tt>$url</tt></a> in $time sec
83                                    </body>
84                                    </html>
85                                    \n\r\n\r
86                            |; # XXX newlines at end are important to flush content to browser
87                    }
88    
89                    if ( $path =~ m{/reload(.*)} ) {
90    
91                            $ENV{FREY_NO_LOG} = 1;
92                            my $cmd = "perl -c $0";
93                            warn "# check config with $cmd";
94                            if ( system($cmd) == 0 ) {
95                                    Frey::Server->new->load_config;
96                                    Module::Reload->check;
97                                    $req->print( refresh( $1, 1 ) );
98                                    warn "# reload done";
99                                    return;
100                            } else {
101                                    warn "ERROR: $?";
102                            }
103                            $ENV{FREY_NO_LOG} = 0;
104            
105                    } elsif ( $path =~ m{/exit(.*)} ) {
106                            # FIXME do we need some kind of check here for production? :-)
107                            # ./bin/dev.sh will restart us during development
108                            $req->print( refresh( $1, 2 ) );
109                            exit;
110                    }
111    
112    #               warn $req->request->header('User_Agent');
113    
114                    my %params = $req->params;
115                    my $html;
116    
117                    sub rest2class {
118                            my $class = shift;
119                            $class =~ s/-/::/; # sigh!
120                            return $class;
121                    }
122    
123    
124                    my $f;
125    
126                    my $editor = Frey::Editor->new;
127    
128                    # shared run params
129                    my $run = {
130                            request_url => $req->request->url,
131                            debug => 1,
132                    };
133    
134                    if (
135                            $path =~ m{/Frey[:-]+ObjectBrowser}
136                    ) {
137                            $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
138                            $f->request( $req );
139                    } elsif (
140                            $path =~ m{/Frey[:-]+ObjectDesigner}
141                    ) {
142                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
143                            $f->request( $req );
144                    } elsif ( $path =~ $editor->url_regex ) {
145                            $req->print( $editor->command( $path ) );
146                            system( $editor->command( $path ) );
147                            return;
148                    } elsif (
149                            $path =~ m{/([^/]+)/(as_\w+)/?([^/]+)?}
150                    ) {
151                            my $class = rest2class $1;
152                            warn "# run $path -> $class $2";
153                            $run->{format} = $3 if $3;
154                            $params{request_url} = $req->request->url;
155                            $req->print( "\r\n\r\n" ); # send something to browser so we don't time-out
156                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run );
157                    } elsif (
158                            $path =~ m{/([^/]+)/?$}
159                    ) {
160                            my $class = rest2class $1;
161                            warn "# introspect $class";
162                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run );
163                    } else {
164                            $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
165                    }
166    
167                    if ( $f ) {
168                            $f->clean_status;
169                            $f->add_status( { request => $req } );
170                            warn "## status ", dump( map { keys %$_ } $f->status );
171                            my $html = $f->html;
172                            die "no html output" unless $html;
173                            warn "## html ",length($html)," bytes";
174                            eval {
175                                    $req->print( $html );
176                            };
177                            die "can't send to wire: $@" if $@;
178                    } else {
179                            warn "# can't call request on nothing!";
180                    }
181    
182            };
183    
184            if ( $@ ) {
185                    warn $@;
186                    $req->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it
187                    $req->print( qq{<pre class="frey-error">$@<pre>} );
188    #               Carp::REPL::repl;
189          }          }
190    
         if ( $path =~ m!/ob/([^/]+)(?:/([^/]*))?! ) {  
                 my $f = Frey::ObjectBrowser->new;  
                 $f->html( $req );  
         }  
191          # If this is a request for the pushtream, then give them that          # If this is a request for the pushtream, then give them that
192          if($path =~ /pushstream/) {          if($path =~ /pushstream/) {
193                  pushstream($req);                  pushstream($req);
194          }          }
195      
196          # 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
197          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
198                  send_message($req);                  send_message($req);
199          }          }
200    
201          my $f = Frey->new;          if ( $req->conn ) {
202          my $classes = Continuity::Widget::DomNode->create(                  $req->conn->close;
203                  ul => [                  warn "## close connection: $@";
204                          map {          }
                                 warn dump( $_ );  
                                 my ( $package, $path ) = %$_;  
                                 ( li => [  
                                         a => { href => '/~/' . $package . '/' } => [ $package ],  
                                         ' ',  
                                         a => { href => '/ob/' . $package } => [ 'browse' ],  
                                         " <tt>$path</tt>"  
                                 ] )  
                         } @{ $f->classes }  
                 ],  
         )->to_string;  
         $req->print( $classes );  
205  }  }
206    
207  # 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.64  
changed lines
  Added in v.571
  ViewVC Help
Powered by ViewVC 1.1.26