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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 142 - (show 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 package Frey::Server;
2
3 use Moose;
4
5 with 'Frey::Web';
6
7 use Continuity;
8 #use Continuity::REPL;
9 use Data::Dump qw/dump/;
10
11 use Carp::REPL;
12 use Frey::ClassLoader;
13
14 my @messages; # Global (shared) list of messages
15 my $got_message; # Flag to indicate that there is a new message to display
16
17 use vars qw( $repl $server );
18
19 #$repl = Continuity::REPL->new;
20
21 sub run {
22 my ( $self, $port ) = @_;
23 $server = Continuity->new(
24 port => $port || 16001,
25 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 $Module::Reload::Debug = 1;
32 Frey::ClassLoader->new->load_all_classes();
33 $server->loop;
34 }
35
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 my ($req) = @_;
41
42 my $path = $req->request->url->path;
43 warn "REQUEST: $path ",dump( $req->params ),"\n";
44
45 Module::Reload->check if $path =~ m!reload! || $req->param('reload');
46
47 # warn $req->request->header('User_Agent');
48
49 # eval {
50 {
51
52 my $f;
53
54 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 } elsif ( $path =~ m!/pod/([^/]+)(.*)! ) {
61 $f = Frey::Pod->new( class => $1 );
62 } else {
63 $f = Frey::ClassBrowser->new;
64 }
65 $f->html( $req ) if $f;
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 Carp::REPL::repl; # FIXME if $self->debug
74
75 }
76
77 # If this is a request for the pushtream, then give them that
78 if($path =~ /pushstream/) {
79 pushstream($req);
80 }
81
82 if ( $path =~ m/die/ ) {
83 Carp::REPL::repl; # FIXME if $self->debug
84 }
85
86 # 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
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 1;

  ViewVC Help
Powered by ViewVC 1.1.26