/[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 28 by dpavlin, Sun Jun 29 20:13:46 2008 UTC revision 456 by dpavlin, Wed Nov 19 15:35:34 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 { $_[0]->url =~ m/^(static|var).*\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },
47          );          );
48          $server->debug_level( 2 );          $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;
64    warn "REQUEST: $path\n";  
65            eval {
66          warn $req->request->header('User_Agent');  
67  #warn dump( $req );                  #warn "REQUEST: $path ",dump( $req->params );
68    
69    # If this is a request for the pushtream, then give them that                  if ( $path =~ m!reload! || $req->param('reload') ) {
70    if($path =~ /pushstream/) {                          warn "# reload!";
71          pushstream($req);                          Module::Reload->check;
72    }                          Frey::Server->new->load_config;
73                      }
74    # If they are sending us a message, we give them a thread for that too  
75    if($path =~ /sendmessage/) {  #               warn $req->request->header('User_Agent');
76          send_message($req);  
77    }                  my %params = $req->params;
78                    my $html;
79    
80                    sub rest2class {
81                            my $class = shift;
82                            $class =~ s/-/::/; # sigh!
83                            return $class;
84                    }
85    
86    
87                    my $f;
88    
89                    my $editor = Frey::Editor->new;
90    
91                    # shared run params
92                    my $run = {
93                            request_url => $req->request->url,
94                    };
95    
96                    if (
97                            $path =~ m{/Frey[:-]+ObjectBrowser}
98                    ) {
99                            $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
100                            $f->request( $req );
101                    } elsif (
102                            $path =~ m{/Frey[:-]+ObjectDesigner}
103                    ) {
104                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
105                            $f->request( $req );
106                    } elsif ( $path =~ $editor->url_regex ) {
107                            $req->print( $editor->command( $path ) );
108                            system( $editor->command( $path ) );
109                            return;
110                    } elsif (
111                            $path =~ m{/([^/]+)/(as_\w+)/?([^/]+)?}
112                    ) {
113                            my $class = rest2class $1;
114                            warn "# run $path -> $class $2";
115                            $run->{format} = $3 if $3;
116                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run );
117                    } elsif (
118                            $path =~ m{/([^/]+)/?$}
119                    ) {
120                            my $class = rest2class $1;
121                            warn "# introspect $class";
122                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run );
123                    } else {
124                            $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
125                    }
126    
127                    if ( $f ) {
128                            $req->print( $f->html );
129                    } else {
130                            warn "# can't call request on nothing!";
131                    }
132    
133            };
134    
135            if ( $@ ) {
136                    warn $@;
137                    $req->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it
138                    $req->print( qq{<pre class="frey-error">$@<pre>} );
139    #               Carp::REPL::repl;
140            }
141    
142            # If this is a request for the pushtream, then give them that
143            if($path =~ /pushstream/) {
144                    pushstream($req);
145            }
146    
147            # If they are sending us a message, we give them a thread for that too
148            if($path =~ /sendmessage/) {
149                    send_message($req);
150            }
151    
   # Otherwise, lets give them page  
   send_page($req);  
152  }  }
153    
154  # 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 188  sub send_message {
188    }    }
189  }  }
190    
 # 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 ( ! $method ) {  
                                 $req->print( Frey::HTML->page( 'package-methods', $req, $module ) );  
                         } 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;  
         }  
 }  
   
191  1;  1;
Legend:
Removed from v.28  
changed lines
  Added in v.456
  ViewVC Help
Powered by ViewVC 1.1.26