/[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 48 by dpavlin, Wed Jul 2 12:36:59 2008 UTC revision 392 by dpavlin, Tue Nov 18 00:55:23 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    
16  my @messages;    # Global (shared) list of messages  my @messages;    # Global (shared) list of messages
17  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 19  my $got_message; # Flag to indicate that
19  use vars qw( $repl $server );  use vars qw( $repl $server );
20    
21  #$repl = Continuity::REPL->new;  #$repl = Continuity::REPL->new;
22  $server = Continuity->new(  
23          port => 16001,  =head1 NAME
24          path_session => 1,  
25          cookie_session => 'sid',  Frey::Server - Continuity based server for Frey
26          callback => \&main,  
27          debug_level => 1,  =head2 DESCRIPTION
28          staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?)$/ },  
29  );  This is one of pissible server implementations for Frey. In it's current stage, it's also most complete one.
30    
31    =head2 run
32    
33      $o->run( $optional_port );
34    
35    =cut
36    
37  sub run {  sub run {
38            my ( $self, $port ) = @_;
39            $server = Continuity->new(
40                    port => $port || $self->config->{port} || 16001,
41                    path_session => 1,
42                    cookie_session => 'sid',
43                    callback => \&main,
44                    debug_level => 2,
45                    staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },
46            );
47            $Module::Reload::Debug = 1; # auto if debug_level > 1
48            Frey::ClassLoader->new->load_all_classes();
49          $server->loop;          $server->loop;
50  }  }
51    
52  # This is the main entrypoint. We are looking for one of three things -- a  =head2 main
53  # pushstream, a sent message, or a request for the main HTML. We delegate each  
54  # 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
55    documented only in source code.
56    
57    =cut
58    
59  sub main {  sub main {
60          my ($req) = @_;          my ($req) = @_;
61      
62          my $path = $req->request->url->path;          my $path = $req->request->url->path;
63          warn "REQUEST: $path\n";          #warn "REQUEST: $path ",dump( $req->params );
64    
65            Module::Reload->check if $path =~ m!reload! || $req->param('reload');
66    
67    #       warn $req->request->header('User_Agent');
68    
69            my %params = $req->params;
70            my $html;
71    
72            sub rest2class {
73                    my $class = shift;
74                    $class =~ s/-/::/; # sigh!
75                    return $class;
76            }
77    
78    
79            eval {
80    
81                    my $f;
82    
83          warn $req->request->header('User_Agent');                  my $run_regexp = join('|', Frey::Run->runnable );
84  #warn dump( $req );  
85                    if (
86                            $path =~ m{/Frey[:-]+ObjectBrowser}
87                    ) {
88                            $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
89                            $f->request( $req );
90                    } elsif (
91                            $path =~ m{/Frey[:-]+ObjectDesigner}
92                    ) {
93                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
94                            $f->request( $req );
95                    } elsif (
96                            $path =~ m{/editor(.+?)\+(\d+)}
97                    ) {
98                            my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
99                            # FIXME SECURITY path verification for $1
100                            my $cmd = "$editor +$2 $1";
101                            warn "# $path -> system $cmd";
102                            $req->print( $cmd );
103                            system( $cmd );
104                            return;
105                    } elsif (
106                            $path =~ m{/([^/]+)/($run_regexp)}
107                    ) {
108                            my $class = rest2class $1;
109                            warn "# run $class $2\n";
110                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, request_url => $req->request->url );
111                    } elsif (
112                            $path =~ m{/([^/]+)/?$}
113                    ) {
114                            my $class = rest2class $1;
115                            warn "# introspect $class";
116                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, request_url => $req->request->url );
117                    } else {
118                            $f = Frey::Run->new( class => 'Frey::ClassBrowser' );
119                    }
120    
121                    if ( $f ) {
122                            $req->print( $f->html );
123                    } else {
124                            warn "# can't call request on nothing!";
125                    }
126    
127            };
128    
129            my $self = $req;
130    
131            if ( $@ ) {
132                    warn $@;
133                    $req->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it
134                    $req->print( qq{<pre class="frey-error">$@<pre>} );
135    #               Carp::REPL::repl;
136    
137            }
138    
139          # If this is a request for the pushtream, then give them that          # If this is a request for the pushtream, then give them that
140          if($path =~ /pushstream/) {          if($path =~ /pushstream/) {
141                  pushstream($req);                  pushstream($req);
142          }          }
143      
144          # 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
145          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
146                  send_message($req);                  send_message($req);
147          }          }
148    
         # Otherwise, lets give them page  
         send_page($req);  
149  }  }
150    
151  # 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 92  sub send_message { Line 185  sub send_message {
185    }    }
186  }  }
187    
 # 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;  
         }  
 }  
   
188  1;  1;
Legend:
Removed from v.48  
changed lines
  Added in v.392
  ViewVC Help
Powered by ViewVC 1.1.26