/[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 477 by dpavlin, Thu Nov 20 13:57:38 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  sub run {  sub run {
39            my ( $self, $port ) = @_;
40            $server = Continuity->new(
41                    port => $port || $self->config->{port} || 16001,
42                    path_session => 1,
43                    cookie_session => 'sid',
44                    callback => \&main,
45                    debug_level => 2,
46                    staticp => sub { $_[0]->url =~ m/^(static|var).*\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },
47            );
48            $Module::Reload::Debug = 1; # auto if debug_level > 1
49            Frey::ClassLoader->new->load_all_classes();
50          $server->loop;          $server->loop;
51  }  }
52    
53  # This is the main entrypoint. We are looking for one of three things -- a  =head2 main
54  # pushstream, a sent message, or a request for the main HTML. We delegate each  
55  # 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
56    documented only in source code.
57    
58    =cut
59    
60  sub main {  sub main {
61          my ($req) = @_;          my ($req) = @_;
62      
63          my $path = $req->request->url->path;          my $path = $req->request->url->path;
         warn "REQUEST: $path\n";  
64    
65          warn $req->request->header('User_Agent');          eval {
66  #warn dump( $req );  
67                    sub refresh {
68                            my $url = shift || '/';
69                            warn "# refresh $url";
70                            qq|
71                                    <html>
72                                    <head>
73                                            <META HTTP-EQUIV="Refresh" CONTENT="1; URL=$url"></META>
74                                    </head>
75                                    <body>
76                                            Refresh <a href="$url"><tt>$url</tt></a>
77                                    </body>
78                                    </html>
79                                    \n\r\n\r
80                            |; # XXX newlines at end are important to flush content to browser
81                    }
82    
83                    if ( $path =~ m{/reload(.*)} ) {
84                            Frey::Server->new->load_config;
85                            Module::Reload->check;
86                            warn "# reload done";
87                            $req->print( refresh( $1 ) );
88                            return;
89                    } elsif ( $path =~ m{/exit(.*)} ) {
90                            # FIXME do we need some kind of check here for production? :-)
91                            # ./bin/dev.sh will restart us during development
92                            $req->print( refresh( $1 ) );
93                            exit;
94                    }
95    
96    #               warn $req->request->header('User_Agent');
97    
98                    my %params = $req->params;
99                    my $html;
100    
101                    sub rest2class {
102                            my $class = shift;
103                            $class =~ s/-/::/; # sigh!
104                            return $class;
105                    }
106    
107    
108                    my $f;
109    
110                    my $editor = Frey::Editor->new;
111    
112                    # shared run params
113                    my $run = {
114                            request_url => $req->request->url,
115                    };
116    
117                    if (
118                            $path =~ m{/Frey[:-]+ObjectBrowser}
119                    ) {
120                            $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
121                            $f->request( $req );
122                    } elsif (
123                            $path =~ m{/Frey[:-]+ObjectDesigner}
124                    ) {
125                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
126                            $f->request( $req );
127                    } elsif ( $path =~ $editor->url_regex ) {
128                            $req->print( $editor->command( $path ) );
129                            system( $editor->command( $path ) );
130                            return;
131                    } elsif (
132                            $path =~ m{/([^/]+)/(as_\w+)/?([^/]+)?}
133                    ) {
134                            my $class = rest2class $1;
135                            warn "# run $path -> $class $2";
136                            $run->{format} = $3 if $3;
137                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run );
138                    } elsif (
139                            $path =~ m{/([^/]+)/?$}
140                    ) {
141                            my $class = rest2class $1;
142                            warn "# introspect $class";
143                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run );
144                    } else {
145                            $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
146                    }
147    
148                    if ( $f ) {
149                            push @{ $f->status }, { req => $req };
150                            $req->print( $f->html );
151                    } else {
152                            warn "# can't call request on nothing!";
153                    }
154    
155            };
156    
157            if ( $@ ) {
158                    warn $@;
159                    $req->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it
160                    $req->print( qq{<pre class="frey-error">$@<pre>} );
161    #               Carp::REPL::repl;
162            }
163    
164          # If this is a request for the pushtream, then give them that          # If this is a request for the pushtream, then give them that
165          if($path =~ /pushstream/) {          if($path =~ /pushstream/) {
166                  pushstream($req);                  pushstream($req);
167          }          }
168      
169          # 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
170          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
171                  send_message($req);                  send_message($req);
172          }          }
173    
         # Otherwise, lets give them page  
         send_page($req);  
174  }  }
175    
176  # 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 210  sub send_message {
210    }    }
211  }  }
212    
 # 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;  
   
                 my $html;  
   
                 if ( $path =~ m/::/ ) {  
                         my ( undef, $module, $method ) = split(m!/!, $path, 3);  
   
                         if ( ! defined( $templates->{$module} ) ) {  
                                 $req->conn->send_status_line( 404, "$module" );  
                                 $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;  
         }  
 }  
   
213  1;  1;
Legend:
Removed from v.38  
changed lines
  Added in v.477
  ViewVC Help
Powered by ViewVC 1.1.26