/[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 55 by dpavlin, Sat Jul 5 19:00:10 2008 UTC revision 526 by dpavlin, Wed Nov 26 02:33:39 2008 UTC
# Line 1  Line 1 
1  package Frey::Server;  package Frey::Server;
2    
3  use Moose;  use Moose;
4    extends 'Frey';
5    with 'Frey::Web';
6    with 'Frey::Config';
7    
8  use Continuity;  use Continuity;
9  #use Continuity::REPL;  #use Continuity::REPL;
 use Continuity::Widget::DomNode;  
10  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
11    
12  use Frey;  #use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much
13  use Frey::Introspect;  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 => 1,  =head2 DESCRIPTION
29          staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?)$/ },  
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 {
47                            $_[0]->url =~ m{^/+(static|var).*\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$}
48                    },
49            );
50            $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;
         warn "REQUEST: $path\n";  
66    
67          warn $req->request->header('User_Agent');          eval {
 #warn dump( $req );  
68    
69          if ( $path =~ m!/~/([^/]+)(?:/([^/]*))?! ) {                  sub refresh {
70                  my $f = Frey::Introspect->new( package => $1 );                          my $url = shift || '/';
71                  $f->html( $req );                          warn "# refresh $url";
72                            qq|
73                                    <html>
74                                    <head>
75                                            <META HTTP-EQUIV="Refresh" CONTENT="2; URL=$url"></META>
76                                    </head>
77                                    <body>
78                                            Refresh <a href="$url"><tt>$url</tt></a>
79                                    </body>
80                                    </html>
81                                    \n\r\n\r
82                            |; # XXX newlines at end are important to flush content to browser
83                    }
84    
85                    if ( $path =~ m{/reload(.*)} ) {
86                            Frey::Server->new->load_config;
87                            Module::Reload->check;
88                            warn "# reload done";
89                            $req->print( refresh( $1 ) );
90                            return;
91                    } elsif ( $path =~ m{/exit(.*)} ) {
92                            # FIXME do we need some kind of check here for production? :-)
93                            # ./bin/dev.sh will restart us during development
94                            $req->print( refresh( $1 ) );
95                            exit;
96                    }
97    
98    #               warn $req->request->header('User_Agent');
99    
100                    my %params = $req->params;
101                    my $html;
102    
103                    sub rest2class {
104                            my $class = shift;
105                            $class =~ s/-/::/; # sigh!
106                            return $class;
107                    }
108    
109    
110                    my $f;
111    
112                    my $editor = Frey::Editor->new;
113    
114                    # shared run params
115                    my $run = {
116                            request_url => $req->request->url,
117                            debug => 1,
118                    };
119    
120                    if (
121                            $path =~ m{/Frey[:-]+ObjectBrowser}
122                    ) {
123                            $f = Frey::ObjectBrowser->new( fey_class => $params{class} );
124                            $f->request( $req );
125                    } elsif (
126                            $path =~ m{/Frey[:-]+ObjectDesigner}
127                    ) {
128                            $f = Frey::ObjectDesigner->new( fey_class => $params{class} );
129                            $f->request( $req );
130                    } elsif ( $path =~ $editor->url_regex ) {
131                            $req->print( $editor->command( $path ) );
132                            system( $editor->command( $path ) );
133                            return;
134                    } elsif (
135                            $path =~ m{/([^/]+)/(as_\w+)/?([^/]+)?}
136                    ) {
137                            my $class = rest2class $1;
138                            warn "# run $path -> $class $2";
139                            $run->{format} = $3 if $3;
140                            $params{request_url} = $req->request->url;
141                            $f = Frey::Run->new( class => $class, params => \%params, run => $2, %$run );
142                    } elsif (
143                            $path =~ m{/([^/]+)/?$}
144                    ) {
145                            my $class = rest2class $1;
146                            warn "# introspect $class";
147                            $f = Frey::Run->new( class => 'Frey::Introspect', params => { class => $class }, %$run );
148                    } else {
149                            $f = Frey::Run->new( class => 'Frey::ClassBrowser', %$run );
150                    }
151    
152                    if ( $f ) {
153                            $f->clean_status;
154                            $f->add_status( { request => $req } );
155                            warn "## status ", dump( map { keys %$_ } $f->status );
156                            my $html = $f->html;
157                            die "no html output" unless $html;
158                            warn "## html ",length($html)," bytes";
159                            $req->print( "$html\n" );
160                    } else {
161                            warn "# can't call request on nothing!";
162                    }
163    
164            };
165    
166            if ( $@ ) {
167                    warn $@;
168                    $req->conn->send_error( 404 );  # FIXME this should probably be 500, but we can't ship page with it
169                    $req->print( qq{<pre class="frey-error">$@<pre>} );
170    #               Carp::REPL::repl;
171          }          }
172    
173          # If this is a request for the pushtream, then give them that          # If this is a request for the pushtream, then give them that
174          if($path =~ /pushstream/) {          if($path =~ /pushstream/) {
175                  pushstream($req);                  pushstream($req);
176          }          }
177      
178          # 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
179          if($path =~ /sendmessage/) {          if($path =~ /sendmessage/) {
180                  send_message($req);                  send_message($req);
181          }          }
182    
183          while ( 1 ) {          if ($req->conn ) {
184                  my $f = Frey->new;                  $req->conn->close;
185                  $req->print( dump( $f->classes ) );                  warn "## close connection: $@";
                 $req->next;  
186          }          }
187  }  }
188    
Legend:
Removed from v.55  
changed lines
  Added in v.526
  ViewVC Help
Powered by ViewVC 1.1.26