/[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 205 by dpavlin, Thu Oct 30 22:34:40 2008 UTC revision 948 by dpavlin, Tue Jan 6 16:04:45 2009 UTC
# Line 1  Line 1 
1  package Frey::Server;  package Frey::Server;
2    
3  use Moose;  use Moose;
4    extends 'Frey::Editor';
5    with 'Frey::Config';
6    
 with 'Frey::Web';  
   
 use Continuity;  
 #use Continuity::REPL;  
7  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
8    
9  #use Carp::REPL; ## XXX it would be nice, but it breaks error reporting too much  #use Carp::REPL; # 'nodie';
 use Frey::ClassLoader;  
   
 my @messages;    # Global (shared) list of messages  
 my $got_message; # Flag to indicate that there is a new message to display  
   
 use vars qw( $repl $server );  
   
 #$repl = Continuity::REPL->new;  
10    
11  =head1 NAME  use lib 'lib';
12    use Frey::Run;
13    
14  Frey::Server - Continuity based server for Frey  has 'port' => (
15            documentation => 'port on which server listen',
16            is => 'ro',
17            isa => 'Int',
18            default => sub {
19                    my $self = shift;
20                    $ENV{FREY_PORT} || $self->config->{port} || 16001
21            },
22    );
23    
24    has 'editor' => (
25            is => 'ro',
26            isa => 'Frey::Editor',
27            lazy => 1,
28            default => sub {
29                    Frey::Editor->new;
30            },
31    );
32    
33  =head2 DESCRIPTION  =head2 request
34    
35  This is one of pissible server implementations for Frey. In it's current stage, it's also most complete one.  This is simple dispatcher for our server. Currently it's in flux and
36    documented only in source code.
 =head2 run  
37    
38    $o->run( $optional_port );    my $content_type = $self->request( $url, $params );
39    
40  =cut  =cut
41    
42  sub run {  sub print {
43          my ( $self, $port ) = @_;          my $self = shift;
44          $server = Continuity->new(          warn "# print ", join(' ', map { length $_ } @_ );
45                  port => $port || 16001,          $self->{_print}->( @_ );
                 path_session => 1,  
                 cookie_session => 'sid',  
                 callback => \&main,  
                 debug_level => 2,  
                 staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?|xml|json|ya?ml)(\?.*)?$/ },  
         );  
         $Module::Reload::Debug = 1; # auto if debug_level > 1  
         Frey::ClassLoader->new->load_all_classes();  
         $server->loop;  
46  }  }
47    
48  =head2 main  sub request {
49            my ( $self, $url, $params ) = @_;
50    
51  This is simple dispatcher for our server. Currently it's in flux and          if ( my $ref = ref($url) ) {
52  documented only in source code.                  die "url not URI but ", dump( $url ) unless $ref =~ m{^URI};
53            } else {
54                    $url = URI->new($url);
55            }
56    
57  =cut          my $path = $url->path;
58    
59            if ( $path =~ m{^/(favicon.ico|__history__.html)$} ) {
60                    warn "INFO: $path ignored";
61                    return { code => 200 };
62            }
63    
64            my $request = {
65                    content_type => 'text/html',
66                    code => 200,
67            };
68    
69  sub main {          eval {
         my ($req) = @_;  
70    
71          my $path = $req->request->url->path;                  if ( $path =~ m{/reload(.*)} ) {
         warn "REQUEST: $path ",dump( $req->params ),"\n";  
72    
73          Module::Reload->check if $path =~ m!reload! || $req->param('reload');                          $ENV{FREY_NO_LOG} = 1;
74                            my $cmd = "perl -c $0";
75                            warn "# check syntax with $cmd";
76                            if ( system($cmd) == 0 ) {
77                                    my $server = Frey::Server->new;
78                                    $self->load_config;
79    #                               Module::Reload->check;
80                                    warn "# reload done";
81                                    $self->print( refresh( $1, 0 ) );
82                                    return;
83                            } else {
84                                    warn "ERROR: $?";
85                            }
86                            $ENV{FREY_NO_LOG} = 0;
87            
88                    } elsif ( $path =~ m{/exit(.*)} ) {
89                            # FIXME do we need some kind of check here for production? :-)
90                            # ./bin/dev.sh will restart us during development
91                            $self->print( refresh( $1, 2 ) );
92                            exit;
93                    }
94    
95  #       warn $req->request->header('User_Agent');                  my $html;
96    
97  #       eval {                  sub rest2class {
98          {                          my $class = shift;
99                            $class =~ s/-/::/; # sigh!
100                            return $class;
101                    }
102    
103                  my $f;                  my $f;
104    
105                  if ( $path =~ m!/~/([^/]+)(.*)! ) {                  # shared run params
106                          $f = Frey::Introspect->new( package => $1 );                  my $run = {
107                  } elsif ( $path =~ m!/ob/([^/]+)(.*)! ) {                          request_url => $url,
108                          $f = Frey::ObjectBrowser->new( fey_class => $1 );  #                       debug => 1,
109                  } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {                  };
110                          $f = Frey::ObjectDesigner->new( fey_class => $1 );  
111                  } elsif ( $path =~ m!/(markup|html)/([^/]+)(.*)! ) {                  if (
112                          $f = Frey::Run->new( class => $2 );                          $path =~ m{/Frey[:-]+ObjectBrowser}
113                    ) {
114                            $f = Frey::ObjectBrowser->new( fey_class => $params->{class} );
115    #                       $f->request( $req );
116                    } elsif (
117                            $path =~ m{/Frey[:-]+ObjectDesigner}
118                    ) {
119                            $f = Frey::ObjectDesigner->new( fey_class => $params->{class} );
120    #                       $f->request( $req );
121                    } elsif ( $path =~ $self->editor->url_regex ) {
122                            $self->print( $self->editor->command( $path ) );
123                            return;
124                    } elsif (
125                            $path =~ m{/([^/]+)/(\w+)/?([^/]+)?}
126                    ) {
127                            my $class = rest2class $1;
128                            warn "# run $path -> $class $2";
129                            $run->{format} = $3 if $3;
130                            $run->{$_} = $params->{$_} foreach keys %$params;
131                            $f = Frey::Run->new( class => $class, params => $run, run => $2 );
132                    } elsif (
133                            $path =~ m{/([^/]+)/?$}
134                    ) {
135                            my $class = rest2class $1;
136                            warn "# introspect $class";
137                            $run->{class} ||= $class;
138                            $f = Frey::Run->new( class => 'Frey::Introspect', params => $run );
139                  } else {                  } else {
140                          $f = Frey::ClassBrowser->new;                          $f = Frey::Run->new( class => 'Frey::Class::Browser', params => $run );
141                  }                  }
                 $f->html( $req ) if $f;  
142    
143          };                  if ( $f ) {
144                            $f->clean_status;
145    #                       $f->add_status( { request => $req } );
146                            $f->status_parts;
147                            if ( my $html = $f->html ) {
148                                    warn "## html ",length($html)," bytes";
149                                    $self->print( $html );
150                            } else {
151                                    confess "no output from $f";
152                            }
153                    } else {
154                            confess "# can't call request on nothing!";
155                    }
156    
157          my $self = $req;                  $request->{content_type} = $f->content_type;
158            };
159    
160          if ( $@ ) {          if ( $@ ) {
161                  warn $@;                  warn "SERVER ERROR: $@";
162                  #$req->conn->send_error( 404 ); # FIXME this should probably be 500, but we can't ship page with it                  $self->print( qq|<pre class="frey-error">$@<pre>| );
                 $req->print( qq{<pre class="error">$@<pre>} );  
163  #               Carp::REPL::repl;  #               Carp::REPL::repl;
164                    return {
165          }                          content_type => 'text/html',
166                            code => 404,
167          # If this is a request for the pushtream, then give them that                  }
         if($path =~ /pushstream/) {  
                 pushstream($req);  
         }  
   
         # If they are sending us a message, we give them a thread for that too  
         if($path =~ /sendmessage/) {  
                 send_message($req);  
168          }          }
169    
170            return $request;
171  }  }
172    
173  # Here we accept a connection to the browser, and keep it open. Meanwhile we  sub refresh {
174  # watch the global $got_message variable, and when it gets touched we send off          my ( $url, $time ) = @_;
175  # the list of messages through the held-open connection. Then we let the          $url  ||= '/';
176  # browser open a new connection and begin again.          $time ||= 0;
177  sub pushstream {          warn "# refresh $url";
178    my ($req) = @_;          qq|
179    # Set up watch event -- this will be triggered when $got_message is written                  <html>
180    my $w = Coro::Event->var(var => \$got_message, poll => 'w');                  <head>
181    while(1) {                          <META HTTP-EQUIV="Refresh" CONTENT="$time; URL=$url"></META>
182      print STDERR "**** GOT MESSAGE, SENDING ****\n";                  </head>
183      my $log = join "<br>", @messages;                  <body>
184      $req->print($log);                          Refresh <a href="$url"><tt>$url</tt></a> in $time sec
185      $req->next;                  </body>
186      print STDERR "**** Waiting for got_message indicator ****\n";                  </html>
187      $w->next;                  \n\r\n\r
188    }          |; # XXX newlines at end are important to flush content to browser
 }  
   
   
 # Watch for the user to send us a message. As soon as we get it, we add it to  
 # our list of messages and touch the $got_message flag to let all the  
 # pushstreams know.  
 sub send_message {  
   my ($req) = @_;  
   while(1) {  
     my $msg = $req->param('message');  
     my $name = $req->param('username');  
     if($msg) {  
       unshift @messages, "$name: $msg";  
       pop @messages if $#messages > 15; # Only keep the recent 15 messages  
     }  
     $got_message = 1;  
     $req->print("Got it!");  
     $req->next;  
   }  
189  }  }
190    
191  1;  1;
Legend:
Removed from v.205  
changed lines
  Added in v.948
  ViewVC Help
Powered by ViewVC 1.1.26