--- trunk/lib/Frey/Server.pm 2008/06/29 18:08:50 26 +++ trunk/lib/Frey/Server.pm 2008/06/30 20:02:06 37 @@ -4,7 +4,7 @@ use warnings; use Continuity; -use Continuity::REPL; +#use Continuity::REPL; use Data::Dump qw/dump/; use base 'Frey'; @@ -15,43 +15,82 @@ use vars qw( $repl $server ); -sub run { - $repl = Continuity::REPL->new; - $server = Continuity->new( - port => 16001, - path_session => 1, - cookie_session => 'sid', - callback => \&main, - ); - $server->debug_level( 2 ); +#$repl = Continuity::REPL->new; +$server = Continuity->new( + port => 16001, + path_session => 1, + cookie_session => 'sid', + callback => \&main, +); +$server->debug_level( 2 ); +sub run { $server->loop; } +my @callbacks; +my $callback_count; + +sub gen_link { + my ($text, $code) = @_; + $callbacks[$callback_count] = $code; + my $out = qq{$text}; + $callback_count++; + return $out; +} + +sub process_links { + my $request = shift; + my $cb = $request->param('cb'); + if (exists $callbacks[$cb]) { + $callbacks[$cb]->($request); +# delete $callbacks[$cb]; + } +} + # This is the main entrypoint. We are looking for one of three things -- a # pushstream, a sent message, or a request for the main HTML. We delegate each # of these cases, none of which will return (they all loop forever). sub main { - my ($req) = @_; + my ($req) = @_; - my $path = $req->request->url->path; - warn "REQUEST: $path\n"; + my $path = $req->request->url->path; + warn "REQUEST: $path\n"; warn $req->request->header('User_Agent'); #warn dump( $req ); - # If this is a request for the pushtream, then give them that - if($path =~ /pushstream/) { - pushstream($req); - } + # 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); - } + # If they are sending us a message, we give them a thread for that too + if($path =~ /sendmessage/) { + send_message($req); + } - # Otherwise, lets give them page - send_page($req); + if ( $path =~ m/test/ ) { + use Data::Dumper; + $Data::Dumper::Deparse = 1; + + my $x = 0; + my $continue = 1; + my $link1 = gen_link('+' => sub { $x++ }); + my $link2 = gen_link('-' => sub { $x-- }); + my $out = gen_link('X' => sub { $continue = 0 }); + while ( $continue ) { + warn "## x = $x ",dump( $req->params ); + $req->print("\$x is now: $x"); + $req->print($link1, ' ', $link2, ' ', $out); + $req->print('
'.Dumper( @callbacks ).'
'); + $req->next; + process_links($req); + } + } + + # Otherwise, lets give them page + send_page($req); } # Here we accept a connection to the browser, and keep it open. Meanwhile we @@ -100,23 +139,29 @@ warn "param = ",dump($req->param); my $path = $req->request->url->path; + my $html; + if ( $path =~ m/::/ ) { my ( undef, $module, $method ) = split(m!/!, $path, 3); if ( ! defined( $templates->{$module} ) ) { $req->conn->send_status_line( 404, "$module" ); - $req->print("Package $module not found"); + $html = "Package $module not found"; + } elsif ( ! $method ) { + $html = Frey::HTML->page( 'package-methods', $req, $module ); } elsif ( grep(/^\Q$method\E$/, @{ $templates->{$module} }) ) { - $req->print( Frey::HTML->page( $method, $req ) ); + $html = Frey::HTML->page( $method, $req ); } else { $req->conn->send_status_line( 404, "$module $method" ); - $req->print("Package $module doesn't have $method"); + $html = "Package $module doesn't have $method"; } } else { - my $html = Frey::HTML->page( 'status' ); - $req->print( $html ); - warn ">> ",length( $html ), " bytes | ", substr($html, 0, 80),$/; + warn "fallback to status page\n"; + $html = Frey::HTML->page( 'status' ); } + + $req->print( $html ); + warn ">> ",length( $html ), " bytes\n"; $req->next; } }