/[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 25 by dpavlin, Sun Jun 29 17:27:45 2008 UTC revision 536 by dpavlin, Wed Nov 26 16:33:58 2008 UTC
# Line 1  Line 1 
1  package Frey::Server;  package Frey::Server;
2    
3  use strict;  use Moose;
4  use warnings;  extends 'Frey';
5    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 base 'Frey';  #use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much
13  use Frey::HTML;  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
19    
20  use vars qw( $repl $server );  use vars qw( $repl $server );
21    
22    #$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          $repl = Continuity::REPL->new;          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 => 2,
46                    staticp => sub {
47                            $_[0]->url =~ m{^/+(static|var).*\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$}
48                    },
49          );          );
50          $server->debug_level( 2 );          $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    my $path = $req->request->url->path;          my $path = $req->request->url->path;
66    warn "REQUEST: $path\n";  
67            eval {
68          warn $req->request->header('User_Agent');  
69  #warn dump( $req );                  sub refresh {
70                            my ( $url, $time ) = @_;
71    # If this is a request for the pushtream, then give them that                          $url  ||= '/';
72    if($path =~ /pushstream/) {                          $time ||= 1;
73          pushstream($req);                          warn "# refresh $url";
74    }                          qq|
75                                      <html>
76    # If they are sending us a message, we give them a thread for that too                                  <head>
77    if($path =~ /sendmessage/) {                                          <META HTTP-EQUIV="Refresh" CONTENT="$time; URL=$url"></META>
78          send_message($req);                                  </head>
79    }                                  <body>
80                                            Refresh <a href="$url"><tt>$url</tt></a> in $time sec
81                                    </body>
82                                    </html>
83                                    \n\r\n\r
84                            |; # XXX newlines at end are important to flush content to browser
85                    }
86    
87                    if ( $path =~ m{/reload(.*)} ) {
88                            Frey::Server->new->load_config;
89                            Module::Reload->check;
90                            warn "# reload done";
91                            $req->print( refresh( $1, 1 ) );
92                            return;
93                    } elsif ( $path =~ m{/exit(.*)} ) {
94                            # FIXME do we need some kind of check here for production? :-)
95                            # ./bin/dev.sh will restart us during development
96                            $req->print( refresh( $1, 2 ) );
97                            exit;
98                    }
99    
100    # Otherwise, lets give them page  #               warn $req->request->header('User_Agent');
101    send_page($req);  
102                    my %params = $req->params;
103                    my $html;
104    
105                    sub rest2class {
106                            my $class = shift;
107                            $class =~ s/-/::/; # sigh!
108                            return $class;
109                    }
110    
111    
112                    my $f;
113    
114                    my $editor = Frey::Editor->new;
115    
116                    # shared run params
117                    my $run = {
118                            request_url => $req->request->url,
119                            debug => 1,
120                    };
121    
122                    if (
123                            $path =~ m{/Frey[:-]+ObjectBrowser}
124                    ) {
125                            $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
126                            $f->request( $req );
127                    } elsif (
128                            $path =~ m{/Frey[:-]+ObjectDesigner}
129                    ) {
130                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
131                            $f->request( $req );
132                    } elsif ( $path =~ $editor->url_regex ) {
133                            $req->print( $editor->command( $path ) );
134                            system( $editor->command( $path ) );
135                            return;
136                    } elsif (
137                            $path =~ m{/([^/]+)/(as_\w+)/?([^/]+)?}
138                    ) {
139                            my $class = rest2class $1;
140                            warn "# run $path -> $class $2";
141                            $run->{format} = $3 if $3;
142                            $params{request_url} = $req->request->url;
143                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run );
144                    } elsif (
145                            $path =~ m{/([^/]+)/?$}
146                    ) {
147                            my $class = rest2class $1;
148                            warn "# introspect $class";
149                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run );
150                    } else {
151                            $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
152                    }
153    
154                    if ( $f ) {
155                            $f->clean_status;
156                            $f->add_status( { request => $req } );
157                            warn "## status ", dump( map { keys %$_ } $f->status );
158                            my $html = $f->html;
159                            die "no html output" unless $html;
160                            warn "## html ",length($html)," bytes";
161                            eval {
162                                    $req->print( $html );
163                            };
164                            die "can't send to wire: $@" if $@;
165                    } else {
166                            warn "# can't call request on nothing!";
167                    }
168    
169            };
170    
171            if ( $@ ) {
172                    warn $@;
173                    $req->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it
174                    $req->print( qq{<pre class="frey-error">$@<pre>} );
175    #               Carp::REPL::repl;
176            }
177    
178            # If this is a request for the pushtream, then give them that
179            if($path =~ /pushstream/) {
180                    pushstream($req);
181            }
182    
183            # If they are sending us a message, we give them a thread for that too
184            if($path =~ /sendmessage/) {
185                    send_message($req);
186            }
187    
188            if ( $req->conn ) {
189                    $req->conn->close;
190                    warn "## close connection: $@";
191            }
192  }  }
193    
194  # 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
# Line 91  sub send_message { Line 228  sub send_message {
228    }    }
229  }  }
230    
 # This isn't a pushstream, nor a new message. It is just the main page. We loop  
 # in case they ask for it multiple times :)  
 sub send_page {  
         my ($req) = @_;  
         my $templates = Template::Declare->templates;  
         while(1) {  
                 warn "param = ",dump($req->param);  
                 my $path = $req->request->url->path;  
   
                 if ( $path =~ m/::/ ) {  
                         my ( undef, $module, $method ) = split(m!/!, $path, 3);  
   
                         if ( ! defined( $templates->{$module} ) ) {  
                                 $req->conn->send_status_line( 404, "$module" );  
                                 $req->print("Package $module not found");  
                         } elsif ( grep(/^\Q$method\E$/, @{ $templates->{$module} }) ) {  
                                 $req->print( Frey::HTML->page( $method, $req ) );  
                         } else {  
                                 $req->conn->send_status_line( 404, "$module $method" );  
                                 $req->print("Package $module doesn't have $method");  
                         }  
                 } else {  
                         my $html = Frey::HTML->page( 'status' );  
                         $req->print( $html );  
                         warn ">> ",length( $html ), " bytes\n";  
                 }  
                 $req->next;  
                 Module::Refresh->refresh;  
         }  
 }  
   
231  1;  1;
Legend:
Removed from v.25  
changed lines
  Added in v.536
  ViewVC Help
Powered by ViewVC 1.1.26