--- trunk/server.pl 2008/06/29 00:17:56 13 +++ trunk/lib/Frey/Server.pm 2008/06/30 20:02:06 37 @@ -1,57 +1,96 @@ -#!/usr/bin/perl +package Frey::Server; -# server of yet unnamed framework - -use warnings; use strict; - -use lib 'lib'; +use warnings; use Continuity; -use Continuity::REPL; +#use Continuity::REPL; use Data::Dump qw/dump/; -use HTML; +use base 'Frey'; +use Frey::HTML; my @messages; # Global (shared) list of messages my $got_message; # Flag to indicate that there is a new message to display use vars qw( $repl $server ); -$repl = Continuity::REPL->new; +#$repl = Continuity::REPL->new; $server = Continuity->new( - port => 16001, - path_session => 1, - cookie_session => 'sid', + port => 16001, + path_session => 1, + cookie_session => 'sid', + callback => \&main, ); $server->debug_level( 2 ); -$server->loop; +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; - print STDERR "Path: '$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); + } + + 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 the base page - send_base_page($req); + # Otherwise, lets give them page + send_page($req); } # Here we accept a connection to the browser, and keep it open. Meanwhile we @@ -93,49 +132,38 @@ # This isn't a pushstream, nor a new message. It is just the main page. We loop # in case they ask for it multiple times :) -sub send_base_page { - my ($req) = @_; - while(1) { - warn "param = ",dump($req->param); - - my $id = $req->param('id'); -# $id = 1 unless $id =~ m/^\d+$/; - - use Strix::User; - my $user = Strix::User->new( id => $id ); - - if ( ! $user ) { - $req->conn->send_status_line( 500, "user $id" ); - $req->print( "Can't find user with id $id" ); - } else { - $req->print( HTML->view( 'user', $user ) ); +sub send_page { + my ($req) = @_; + my $templates = Template::Declare->templates; + while(1) { + 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" ); + $html = "Package $module not found"; + } elsif ( ! $method ) { + $html = Frey::HTML->page( 'package-methods', $req, $module ); + } elsif ( grep(/^\Q$method\E$/, @{ $templates->{$module} }) ) { + $html = Frey::HTML->page( $method, $req ); + } else { + $req->conn->send_status_line( 404, "$module $method" ); + $html = "Package $module doesn't have $method"; + } + } else { + warn "fallback to status page\n"; + $html = Frey::HTML->page( 'status' ); + } + + $req->print( $html ); + warn ">> ",length( $html ), " bytes\n"; + $req->next; } - -=for later - $req->print(qq{ - - - Chat! - - - - -
- - - - -
-
-
-- no messages yet --
- - - }); -=cut - $req->next; - - Module::Refresh->refresh; - } } - +1;