/[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 101 - (hide annotations)
Fri Jul 11 22:54:42 2008 UTC (15 years, 8 months ago) by dpavlin
File size: 3333 byte(s)
another refactor to support multiple databases [0.09]

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

  ViewVC Help
Powered by ViewVC 1.1.26