/[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

Annotation of /trunk/lib/Frey/Server.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 142 - (hide annotations)
Wed Jul 16 14:14:18 2008 UTC (14 years, 6 months ago) by dpavlin
File size: 3374 byte(s)
skeleton of reload functionality, non-working for now
1 dpavlin 19 package Frey::Server;
2 dpavlin 2
3 dpavlin 55 use Moose;
4 dpavlin 10
5 dpavlin 100 with 'Frey::Web';
6    
7 dpavlin 2 use Continuity;
8 dpavlin 36 #use Continuity::REPL;
9 dpavlin 2 use Data::Dump qw/dump/;
10    
11 dpavlin 121 use Carp::REPL;
12 dpavlin 101 use Frey::ClassLoader;
13 dpavlin 23
14 dpavlin 2 my @messages; # Global (shared) list of messages
15     my $got_message; # Flag to indicate that there is a new message to display
16    
17 dpavlin 10 use vars qw( $repl $server );
18 dpavlin 2
19 dpavlin 34 #$repl = Continuity::REPL->new;
20 dpavlin 37
21 dpavlin 25 sub run {
22 dpavlin 103 my ( $self, $port ) = @_;
23 dpavlin 64 $server = Continuity->new(
24 dpavlin 103 port => $port || 16001,
25 dpavlin 64 path_session => 1,
26     cookie_session => 'sid',
27     callback => \&main,
28     debug_level => 1,
29     staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js|html?)$/ },
30     );
31 dpavlin 114 $Module::Reload::Debug = 1;
32 dpavlin 101 Frey::ClassLoader->new->load_all_classes();
33 dpavlin 25 $server->loop;
34     }
35 dpavlin 2
36     # This is the main entrypoint. We are looking for one of three things -- a
37     # pushstream, a sent message, or a request for the main HTML. We delegate each
38     # of these cases, none of which will return (they all loop forever).
39     sub main {
40 dpavlin 37 my ($req) = @_;
41 dpavlin 2
42 dpavlin 37 my $path = $req->request->url->path;
43 dpavlin 142 warn "REQUEST: $path ",dump( $req->params ),"\n";
44 dpavlin 2
45 dpavlin 142 Module::Reload->check if $path =~ m!reload! || $req->param('reload');
46 dpavlin 120
47 dpavlin 142 # warn $req->request->header('User_Agent');
48 dpavlin 2
49 dpavlin 142 # eval {
50     {
51 dpavlin 66
52 dpavlin 114 my $f;
53 dpavlin 66
54 dpavlin 114 if ( $path =~ m!/~/([^/]+)(.*)! ) {
55     $f = Frey::Introspect->new( package => $1 );
56     } elsif ( $path =~ m!/ob/([^/]+)(.*)! ) {
57     $f = Frey::ObjectBrowser->new( fey_class => $1 );
58     } elsif ( $path =~ m!/od/([^/]+)(.*)! ) {
59     $f = Frey::ObjectDesigner->new( fey_class => $1 );
60 dpavlin 127 } elsif ( $path =~ m!/pod/([^/]+)(.*)! ) {
61     $f = Frey::Pod->new( class => $1 );
62 dpavlin 121 } else {
63     $f = Frey::ClassBrowser->new;
64 dpavlin 66 }
65 dpavlin 114 $f->html( $req ) if $f;
66 dpavlin 66
67     };
68    
69     if ( $@ ) {
70     warn $@;
71     #$req->conn->send_error( 404 ); # FIXME this should probably be 500, but we can't ship page with it
72     $req->print( qq{<pre class="error">$@<pre>} );
73 dpavlin 121 Carp::REPL::repl; # FIXME if $self->debug
74 dpavlin 67
75 dpavlin 53 }
76    
77 dpavlin 37 # If this is a request for the pushtream, then give them that
78     if($path =~ /pushstream/) {
79     pushstream($req);
80     }
81 dpavlin 121
82     if ( $path =~ m/die/ ) {
83     Carp::REPL::repl; # FIXME if $self->debug
84     }
85    
86 dpavlin 37 # If they are sending us a message, we give them a thread for that too
87     if($path =~ /sendmessage/) {
88     send_message($req);
89     }
90 dpavlin 2
91     }
92    
93     # Here we accept a connection to the browser, and keep it open. Meanwhile we
94     # watch the global $got_message variable, and when it gets touched we send off
95     # the list of messages through the held-open connection. Then we let the
96     # browser open a new connection and begin again.
97     sub pushstream {
98     my ($req) = @_;
99     # Set up watch event -- this will be triggered when $got_message is written
100     my $w = Coro::Event->var(var => \$got_message, poll => 'w');
101     while(1) {
102     print STDERR "**** GOT MESSAGE, SENDING ****\n";
103     my $log = join "<br>", @messages;
104     $req->print($log);
105     $req->next;
106     print STDERR "**** Waiting for got_message indicator ****\n";
107     $w->next;
108     }
109     }
110    
111    
112     # Watch for the user to send us a message. As soon as we get it, we add it to
113     # our list of messages and touch the $got_message flag to let all the
114     # pushstreams know.
115     sub send_message {
116     my ($req) = @_;
117     while(1) {
118     my $msg = $req->param('message');
119     my $name = $req->param('username');
120     if($msg) {
121     unshift @messages, "$name: $msg";
122     pop @messages if $#messages > 15; # Only keep the recent 15 messages
123     }
124     $got_message = 1;
125     $req->print("Got it!");
126     $req->next;
127     }
128     }
129    
130 dpavlin 25 1;

  ViewVC Help
Powered by ViewVC 1.1.26