/[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 2 - (hide annotations)
Sat Jun 28 11:49:35 2008 UTC (15 years, 9 months ago) by dpavlin
Original Path: trunk/server.pl
File MIME type: text/plain
File size: 3981 byte(s)
initial code dump of my web-framework-tingy:

Continuity + Fey::ORM + Template::Declare
1 dpavlin 2 #!/usr/bin/perl
2    
3     # "HTTP Push" is not readily attainable, so instead we will simulate it using a
4     # long-pull, aka "Comet". The client browser simply opens an HTTP connection to
5     # the server and waits for a response. The server doesn't respond until there
6     # is some event (here a new message), giving the appearance of HTTP-push.
7     #
8     # Each user gets three continuations for these three cases:
9     #
10     # - Initial load or reload of the page
11     # - Sending a message (uses AJAX on the client)
12     # - Recieving messages (uses COMET on the client)
13    
14     use strict;
15     use lib 'lib';
16     use Continuity;
17     use Continuity::REPL;
18     use Data::Dump qw/dump/;
19    
20     use View;
21    
22     use Template::Declare;
23     use Template::Declare::Tags; # defaults to 'HTML'
24     Template::Declare->init( roots => ['View']);
25     warn "templates = ",dump( Template::Declare->templates );
26    
27     my @messages; # Global (shared) list of messages
28     my $got_message; # Flag to indicate that there is a new message to display
29    
30     use vars qw( $repl $server @messages );
31     $repl = Continuity::REPL->new;
32    
33     $server = Continuity->new(
34     port => 16001,
35     path_session => 1,
36     cookie_session => 'sid',
37     );
38     $server->debug_level( 2 );
39    
40     $server->loop;
41    
42     # This is the main entrypoint. We are looking for one of three things -- a
43     # pushstream, a sent message, or a request for the main HTML. We delegate each
44     # of these cases, none of which will return (they all loop forever).
45     sub main {
46     my ($req) = @_;
47    
48     my $path = $req->request->url->path;
49     print STDERR "Path: '$path'\n";
50    
51     warn $req->request->header('User_Agent');
52     #warn dump( $req );
53    
54     # If this is a request for the pushtream, then give them that
55     if($path =~ /pushstream/) {
56     pushstream($req);
57     }
58    
59     # If they are sending us a message, we give them a thread for that too
60     if($path =~ /sendmessage/) {
61     send_message($req);
62     }
63    
64     # Otherwise, lets give them the base page
65     send_base_page($req);
66     }
67    
68     # Here we accept a connection to the browser, and keep it open. Meanwhile we
69     # watch the global $got_message variable, and when it gets touched we send off
70     # the list of messages through the held-open connection. Then we let the
71     # browser open a new connection and begin again.
72     sub pushstream {
73     my ($req) = @_;
74     # Set up watch event -- this will be triggered when $got_message is written
75     my $w = Coro::Event->var(var => \$got_message, poll => 'w');
76     while(1) {
77     print STDERR "**** GOT MESSAGE, SENDING ****\n";
78     my $log = join "<br>", @messages;
79     $req->print($log);
80     $req->next;
81     print STDERR "**** Waiting for got_message indicator ****\n";
82     $w->next;
83     }
84     }
85    
86    
87     # Watch for the user to send us a message. As soon as we get it, we add it to
88     # our list of messages and touch the $got_message flag to let all the
89     # pushstreams know.
90     sub send_message {
91     my ($req) = @_;
92     while(1) {
93     my $msg = $req->param('message');
94     my $name = $req->param('username');
95     if($msg) {
96     unshift @messages, "$name: $msg";
97     pop @messages if $#messages > 15; # Only keep the recent 15 messages
98     }
99     $got_message = 1;
100     $req->print("Got it!");
101     $req->next;
102     }
103     }
104    
105     # This isn't a pushstream, nor a new message. It is just the main page. We loop
106     # in case they ask for it multiple times :)
107     sub send_base_page {
108     my ($req) = @_;
109     while(1) {
110     warn "base page";
111     $req->out( Template::Declare->show( 'user' ) );
112     =for later
113     $req->print(qq{
114     <html>
115     <head>
116     <title>Chat!</title>
117     <script src="jquery.js" type="text/javascript"></script>
118     <script src="chat-ajax-push.js" type="text/javascript"></script>
119     </head>
120     <body>
121     <form id=f>
122     <input type=text id=username name=usernamename size=10>
123     <input type=text id=message name=message size=50>
124     <input type=submit name="sendbutton" value="Send" id="sendbutton">
125     <span id=status></span>
126     </form>
127     <br>
128     <div id=log>-- no messages yet --</div>
129     </body>
130     </html>
131     });
132     =cut
133     $req->next;
134     }
135     }
136    
137    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26