/[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 38 by dpavlin, Mon Jun 30 20:02:08 2008 UTC revision 618 by dpavlin, Sat Nov 29 15:19:43 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
# Line 16  my $got_message; # Flag to indicate that Line 20  my $got_message; # Flag to indicate that
20  use vars qw( $repl $server );  use vars qw( $repl $server );
21    
22  #$repl = Continuity::REPL->new;  #$repl = Continuity::REPL->new;
23  $server = Continuity->new(  
24          port => 16001,  =head1 NAME
25          path_session => 1,  
26          cookie_session => 'sid',  Frey::Server - Continuity based server for Frey
27          callback => \&main,  
28          debug_level => 3,  =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    our $editor = Frey::Editor->new;
39    
40  sub run {  sub run {
41            my ( $self, $port ) = @_;
42            $server = Continuity->new(
43                    port => $port || $self->config->{port} || 16001,
44                    path_session => 1,
45                    cookie_session => 'sid',
46                    callback => \&main,
47                    debug_level => 2,
48                    staticp => sub {
49                            $_[0]->url =~ m{^/+(static|var).*\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$}
50                    },
51            );
52            $Module::Reload::Debug = 1; # auto if debug_level > 1
53            Frey::ClassLoader->new->load_all_classes();
54            $editor->switch_screen if $ENV{FREY_SWITCH_SCREEN};
55          $server->loop;          $server->loop;
56  }  }
57    
58  # This is the main entrypoint. We are looking for one of three things -- a  =head2 main
59  # pushstream, a sent message, or a request for the main HTML. We delegate each  
60  # 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
61    documented only in source code.
62    
63    =cut
64    
65  sub main {  sub main {
66          my ($req) = @_;          my ($req) = @_;
67      
68    #       $req->send_headers("X-Frey-VERSION: $Frey::VERSION");
69    
70          my $path = $req->request->url->path;          my $path = $req->request->url->path;
         warn "REQUEST: $path\n";  
71    
72          warn $req->request->header('User_Agent');          eval {
73  #warn dump( $req );  
74                    if ( $path =~ m{/reload(.*)} ) {
75    
76                            $ENV{FREY_NO_LOG} = 1;
77                            my $cmd = "perl -c $0";
78                            warn "# check config with $cmd";
79                            if ( system($cmd) == 0 ) {
80                                    $req->print( "\r\n" );
81                                    my $server = Frey::Server->new;
82                                    $server->load_config;
83                                    $req->print( "\r\n" );
84                                    Module::Reload->check;
85                                    $req->print( "\r\n" );
86                                    $req->print( refresh( $1, 1 ) );
87                                    $req->print( "\r\n" );
88                                    warn "# reload done";
89                                    return;
90                            } else {
91                                    warn "ERROR: $?";
92                            }
93                            $ENV{FREY_NO_LOG} = 0;
94            
95                    } elsif ( $path =~ m{/exit(.*)} ) {
96                            # FIXME do we need some kind of check here for production? :-)
97                            # ./bin/dev.sh will restart us during development
98                            $req->print( refresh( $1, 2 ) );
99                            $req->print( "\r\n" );
100                            exit;
101                    }
102    
103    #               warn $req->request->header('User_Agent');
104    
105                    my %params = $req->params;
106                    my $html;
107    
108                    sub rest2class {
109                            my $class = shift;
110                            $class =~ s/-/::/; # sigh!
111                            return $class;
112                    }
113    
114    
115                    my $f;
116    
117                    # shared run params
118                    my $run = {
119                            request_url => $req->request->url,
120                            debug => 1,
121                    };
122    
123                    if (
124                            $path =~ m{/Frey[:-]+ObjectBrowser}
125                    ) {
126                            $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
127                            $f->request( $req );
128                    } elsif (
129                            $path =~ m{/Frey[:-]+ObjectDesigner}
130                    ) {
131                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
132                            $f->request( $req );
133                    } elsif ( $path =~ $editor->url_regex ) {
134                            $req->print( $editor->command( $path ) );
135                            return;
136                    } elsif (
137                            $path =~ m{/([^/]+)/(\w*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                            $req->print( "\r\n\r\n" ); # send something to browser so we don't time-out
144                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run );
145                    } elsif (
146                            $path =~ m{/([^/]+)/?$}
147                    ) {
148                            my $class = rest2class $1;
149                            warn "# introspect $class";
150                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run );
151                    } else {
152                            $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
153                    }
154    
155                    if ( $f ) {
156                            $f->clean_status;
157                            $f->add_status( { request => $req } );
158                            $f->status_parts;
159                            if ( my $html = $f->html ) {
160                                    warn "## html ",length($html)," bytes";
161                                    $req->print( $html );
162                            } else {
163                                    confess "no output from $f";
164                            }
165                    } else {
166                            confess "# can't call request on nothing!";
167                    }
168    
169            };
170    
171            if ( $@ ) {
172                    warn "SERVER ERROR: $@";
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>\r\n\r\n} );
175    #               Carp::REPL::repl;
176            }
177    
178          # If this is a request for the pushtream, then give them that          # If this is a request for the pushtream, then give them that
179          if($path =~ /pushstream/) {          if($path =~ /pushstream/) {
180                  pushstream($req);                  pushstream($req);
181          }          }
182      
183          # 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
184          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
185                  send_message($req);                  send_message($req);
186          }          }
187    
188          # Otherwise, lets give them page          if ( $req->conn ) {
189          send_page($req);                  $req->print( "\r\n" ); # flush
190                    $req->conn->close;
191                    warn "## close connection: $@";
192            }
193  }  }
194    
195  # 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 229  sub send_message {
229    }    }
230  }  }
231    
232  # This isn't a pushstream, nor a new message. It is just the main page. We loop  sub refresh {
233  # in case they ask for it multiple times :)          my ( $url, $time ) = @_;
234  sub send_page {          $url  ||= '/';
235          my ($req) = @_;          $time ||= 1;
236          my $templates = Template::Declare->templates;          warn "# refresh $url";
237          while(1) {          qq|
238                  warn "param = ",dump($req->param);                  <html>
239                  my $path = $req->request->url->path;                  <head>
240                            <META HTTP-EQUIV="Refresh" CONTENT="$time; URL=$url"></META>
241                  my $html;                  </head>
242                    <body>
243                  if ( $path =~ m/::/ ) {                          Refresh <a href="$url"><tt>$url</tt></a> in $time sec
244                          my ( undef, $module, $method ) = split(m!/!, $path, 3);                  </body>
245                    </html>
246                          if ( ! defined( $templates->{$module} ) ) {                  \n\r\n\r
247                                  $req->conn->send_status_line( 404, "$module" );          |; # XXX newlines at end are important to flush content to browser
                                 $html = "Package $module not found";  
                         } elsif ( ! $method ) {  
                                 $html = Frey::HTML->page( 'package-methods', $req, $module );  
                         } elsif ( grep(/^\Q$method\E$/, @{ $templates->{$module} }) ) {  
                                 $html = Frey::HTML->page( $method, $req );  
                         } else {  
                                 $req->conn->send_status_line( 404, "$module $method" );  
                                 $html = "Package $module doesn't have $method";  
                         }  
                 } else {  
                         warn "fallback to status page\n";  
                         $html = Frey::HTML->page( 'status' );  
                 }  
   
                 $req->print( $html );  
                 warn ">> ",length( $html ), " bytes\n";  
                 $req->next;  
         }  
248  }  }
249    
250  1;  1;
Legend:
Removed from v.38  
changed lines
  Added in v.618
  ViewVC Help
Powered by ViewVC 1.1.26