1package Continuity;
2
3our $VERSION = '1.6';
4
5=head1 NAME
6
7Continuity - Abstract away statelessness of HTTP, for stateful Web applications
8
9=head1 SYNOPSIS
10
11  #!/usr/bin/perl
12
13  use strict;
14  use Continuity;
15
16  my $server = new Continuity;
17  $server->loop;
18
19  sub main {
20    my $request = shift;
21    $request->print("Your name: <form><input type=text name=name></form>");
22    $request->next; # this waits for the form to be submitted!
23    my $name = $request->param('name');
24    $request->print("Hello $name!");
25  }
26
27=head1 DESCRIPTION
28
29Continuity is a library to simplify web applications. Each session is written
30and runs as a persistent application, and is able to request additional input
31at any time without exiting. This is significantly different from the
32traditional CGI model of web applications in which a program is restarted for
33each new request.
34
35The program is passed a C<< $request >> variable which holds the request
36(including any form data) sent from the browser. In concept, this is a lot like
37a C<$cgi> object from CGI.pm with one very very significant difference. At any
38point in the code you can call $request->next. Your program will then suspend,
39waiting for the next request in the session. Since the program doesn't actually
40halt, all state is preserved, including lexicals -- getting input from the
41browser is then similar to doing C<< $line = <> >> in a command-line
42application.
43
44=head1 GETTING STARTED
45
46The first thing to make a note of is that your application is a continuously
47running program, basically a self contained webserver. This is quite unlike a
48CGI.pm based application, which is re-started for each new request from a
49client browser. Once you step away from your CGI.pm experience this is actually
50more natural (IMO), more like writing an interactive desktop or command-line
51program.
52
53Here's a simple example:
54
55  #!/usr/bin/perl
56
57  use strict;
58  use Continuity;
59
60  my $server = new Continuity;
61  $server->loop;
62
63  sub main {
64    my $request = shift;
65    while(1) {
66      $request->print("Hello, world!");
67      $request->next;
68      $request->print("Hello again!");
69    }
70  }
71
72First, check out the small demo applications in the eg/ directory of the
73distribution. Sample code there ranges from simple counters to more complex
74multi-user ajax applications. All of the basic uses and some of the advanced
75uses of Continuity are covered there.
76
77Here is an brief explanation of what you will find in a typical application.
78
79Declare all your globals, then declare and create your server. Parameters to
80the server will determine how sessions are tracked, what ports it listens on,
81what will be served as static content, and things of that nature. You are
82literally initializing a web server that will serve your application to client
83browsers. Then call the C<loop> method of the server, which will get the server
84listening for incoming requests and starting new sessions (this never exits).
85
86  use Continuity;
87  my $server = Continuity->new( port => 8080 );
88  $server->loop;
89
90Continuity must have a starting point when starting new sessions for your
91application. The default is C<< \&::main >> (a sub named "main" in the default
92global scope), which is passed the C<< $request >> handle. See the
93L<Continuity::Request> documentation for details on the methods available from
94the C<$request> object beyond this introduction.
95
96  sub main {
97    my $request = shift;
98    # ...
99  }
100
101Outputting to the client (that is, sending text to the browser) is done by
102calling the C<$request-E<gt>print(...)> method, rather than the plain C<print> used
103in CGI.pm applications.
104
105  $request->print("Hello, guvne'<br>");
106  $request->print("'ow ya been?");
107
108HTTP query parameters (both GET and POST) are also gotten through the
109C<$request> handle, by calling C<$p = $request-E<gt>param('x')>, just like in
110CGI.pm.
111
112  # If they go to http://webapp/?x=7
113  my $input = $request->param('x');
114  # now $input is 7
115
116Once you have output your HTML, call C<$request-E<gt>next> to wait for the next
117response from the client browser. While waiting other sessions will handle
118other requests, allowing the single process to handle many simultaneous
119sessions.
120
121  $request->print("Name: <form><input type=text name=n></form>");
122  $request->next;                   # <-- this is where we suspend execution
123  my $name = $request->param('n');  # <-- start here once they submit
124
125Anything declared lexically (using my) inside of C<main> is private to the
126session, and anything you make global is available to all sessions. When
127C<main> returns the session is terminated, so that another request from the
128same client will get a new session. Only one continuation is ever executing at
129a given time, so there is no immediate need to worry about locking shared
130global variables when modifying them.
131
132=head1 ADVANCED USAGE
133
134Merely using the above code can completely change the way you think about web
135application infrastructure. But why stop there? Here are a few more things to
136ponder.
137
138=head2 Coro::Event
139
140Since Continuity is based on L<Coro>, we also get to use L<Coro::Event>. This
141means that you can set timers to wake a continuation up after a while, or you
142can have inner-continuation signaling by watch-events on shared variables.
143
144=head2 Multiple sessions per-user
145
146For AJAX applications, we've found it handy to give each user multiple
147sessions. In the chat-ajax-push demo each user gets a session for sending
148messages, and a session for receiving them. The receiving session uses a
149long-running request (aka COMET) and watches the globally shared chat message
150log. When a new message is put into the log, it pushes to all of the ajax
151listeners.
152
153=head2 Lexical storage and callback links
154
155Don't forget about those pretty little lexicals you have at your disposal.
156Taking a hint from the Seaside folks, instead of regular links you could have
157callbacks that trigger a anonymous subs. Your code could look like:
158
159  use Continuity;
160  use strict;
161  my @callbacks;
162  my $callback_count;
163  Continuity->new->loop;
164  sub gen_link {
165    my ($text, $code) = @_;
166    $callbacks[$callback_count++] = $code;
167    return qq{<a href="?cb=$callback_count">$text</a>};
168  }
169  sub process_links {
170    my $request = shift;
171    my $cb = $request->param('cb');
172    if(exists $callbacks[$cb]) {
173      $callbacks[$cb]->($request);
174      delete $callbacks[$cb];
175    }
176  }
177  sub main {
178    my $request = shift;
179    my $x;
180    my $link1 = gen_link('This is a link to stuff' => sub { $x = 7  });
181    my $link2 = gen_link('This is another link'    => sub { $x = 42 });
182    $request->print($link1, $link2);
183    $request->next;
184    process_links($request);
185    $request->print("\$x is now: $x");
186  }
187
188=head2 Scaling
189
190To scale a Continuity-based application beyond a single process you need to
191investigate the keywords "session affinity". The Seaside folks have a few
192articles on various experiments they've done for scaling, see the wiki for
193links and ideas. Note, however, that premature optimization is evil. We
194shouldn't even be talking about this.
195
196=head1 EXTENDING AND CUSTOMIZING
197
198This library is designed to be extensible but have good defaults. There are two
199important components which you can extend or replace.
200
201The Adapter, such as the default L<Continuity::Adapt::HttpDaemon>, actually
202makes the HTTP connections with the client web browser. If you want to use
203FastCGI or even a non-HTTP protocol, then you will use or create an Adapter.
204
205The Mapper, such as the default L<Continuity::Mapper>, identifies incoming
206requests from The Adapter and maps them to instances of your program. In other
207words, Mappers keep track of sessions, figuring out which requests belong to
208which session. The default mapper can identify sessions based on any
209combination of cookie, IP address, and URL path. Override The Mapper to create
210alternative session identification and management.
211
212=head1 METHODS
213
214The main instance of a continuity server really only has two methods, C<new>
215and C<loop>. These are used at the top of your program to do setup and start
216the server. Please look at L<Continuity::Request> for documentation on the
217C<$request> object that is passed to each session in your application.
218
219=cut
220
221use strict;
222use warnings;
223
224use Coro;
225use HTTP::Status; # to grab static response codes. Probably shouldn't be here
226use Continuity::RequestHolder;
227use List::Util 'first';
228
229sub debug_level :lvalue { $_[0]->{debug_level} }         # Debug level (integer)
230sub adapter :lvalue { $_[0]->{adapter} }
231sub mapper :lvalue { $_[0]->{mapper} }
232sub debug_callback :lvalue { $_[0]->{debug_callback} }
233
234=head2 $server = Continuity->new(...)
235
236The C<Continuity> object wires together an Adapter and a mapper.
237Creating the C<Continuity> object gives you the defaults wired together,
238or if user-supplied instances are provided, it wires those together.
239
240Arguments:
241
242=over 4
243
244=item * C<callback> -- coderef of the main application to run persistently for each unique visitor -- defaults to C<\&::main>
245
246=item * C<adapter> -- defaults to an instance of C<Continuity::Adapt::HttpDaemon>
247
248=item * C<mapper> -- defaults to an instance of C<Continuity::Mapper>
249
250=item * C<docroot> -- defaults to C<.>
251
252=item * C<staticp> -- defaults to C<< sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js)$/ } >>, used to indicate whether any request is for static content
253
254=item * C<debug_level> -- Set level of debugging. 0 for nothing, 1 for warnings and system messages, 2 for request status info. Default is 1
255
256=item * C<debug_callback> -- Callback for debug messages. Default is print.
257
258=back
259
260Arguments passed to the default adapter:
261
262=over 4
263
264=item * C<port> -- the port on which to listen
265
266=item * C<no_content_type> -- defaults to 0, set to 1 to disable the C<Content-Type: text/html> header and similar headers
267
268=back
269
270Arguments passed to the default mapper:
271
272=over 4
273
274=item * C<cookie_session> -- set to name of cookie or undef for no cookies (defaults to 'cid')
275
276=item * C<query_session> -- set to the name of a query variable for session tracking (defaults to undef)
277
278=item * C<assign_session_id> -- coderef of routine to custom generate session id numbers (defaults to a simple random string generator)
279
280=item * C<cookie_life> -- lifespan of the cookie, as in CGI::set_cookie (defaults to "+2d")
281
282=item * C<ip_session> -- set to true to enable ip-addresses for session tracking (defaults to false)
283
284=item * C<path_session> -- set to true to use URL path for session tracking (defaults to false)
285
286=item * C<implicit_first_next> -- set to false to get an empty first request to the main callback (defaults to true)
287
288=back
289
290=cut
291
292sub new {
293
294  my $this = shift;
295  my $class = ref($this) || $this;
296
297  no strict 'refs';
298  my $self = bless {
299    docroot => '.',   # default docroot
300    mapper => undef,
301    adapter => undef,
302    debug_level => 1,
303    debug_callback => sub { print STDERR "@_\n" },
304    reload => 1, # XXX
305    callback => (exists &{caller()."::main"} ? \&{caller()."::main"} : undef),
306    staticp => sub { $_[0]->url =~ m/\.(jpg|jpeg|gif|png|css|ico|js)$/ },
307    no_content_type => 0,
308    reap_after => undef,
309    allowed_methods => ['GET', 'POST'],
310    @_,
311  }, $class;
312
313  use strict 'refs';
314
315  if($self->{reload}) {
316    eval "use Module::Reload";
317    $self->{reload} = 0 if $@;
318    $Module::Reload::Debug = 1 if $self->debug_level > 1;
319  }
320
321  # Set up the default Adapter.
322  # The adapter plugs the system into a server (probably a Web server)
323  # The default has its very own HTTP::Daemon running.
324  if(!$self->{adapter} || !(ref $self->{adapter})) {
325    my $adapter_name = 'HttpDaemon';
326    if(defined &Plack::Runner::new) {
327      require Continuity::Adapt::PSGI;
328      $adapter_name = 'PSGI';
329    }
330    my $adapter = "Continuity::Adapt::" . ($self->{adapter} || $adapter_name);
331    eval "require $adapter";
332    die "Continuity: Unknown adapter '$adapter'\n" if $@;
333    $self->{adapter} = $adapter->new(
334      docroot => $self->{docroot},
335      server => $self,
336      debug_level => $self->debug_level,
337      debug_callback => $self->debug_callback,
338      no_content_type => $self->{no_content_type},
339      $self->{port} ? (LocalPort => $self->{port}) : (),
340      $self->{cookie_life} ? (cookie_life => $self->{cookie_life}) : (),
341    );
342  }
343
344  # Set up the default mapper.
345  # The mapper associates execution contexts (continuations) with requests
346  # according to some criteria. The default version uses a combination of
347  # client IP address and the path in the request.
348
349  if(!$self->{mapper}) {
350
351    require Continuity::Mapper;
352
353    my %optional;
354    $optional{LocalPort} = $self->{port} if defined $self->{port};
355    for(qw/ip_session path_session query_session cookie_session assign_session_id
356           implicit_first_next/) {
357        # be careful to pass 0 too if the user specified 0 to turn it off
358        $optional{$_} = $self->{$_} if defined $self->{$_};
359    }
360
361    $self->{mapper} = Continuity::Mapper->new(
362      debug_level => $self->debug_level,
363      debug_callback => sub { print "@_\n" },
364      callback => $self->{callback},
365      server => $self,
366      %optional,
367    );
368
369  } else {
370
371    # Make sure that the provided mapper knows who we are
372    $self->{mapper}->{server} = $self;
373
374  }
375
376  $self->start_request_loop;
377
378  return $self;
379}
380
381sub start_request_loop {
382  my ($self) = @_;
383  async {
384    local $Coro::current->{desc} = 'Continuity Request Loop';
385    while(1) {
386      $self->debug(3, "Getting request from adapter");
387      my $r = $self->adapter->get_request;
388      $self->debug(3, "Handling request");
389      $self->handle_request($r);
390    }
391  };
392}
393
394sub handle_request {
395  my ($self, $r) = @_;
396
397  if($self->{reload}) {
398    Module::Reload->check;
399  }
400
401  my $method = $r->method;
402  unless(first { $_ eq $method } @{$self->{allowed_methods}}) {
403    $r->conn->send_error(
404      RC_BAD_REQUEST,
405      "$method not supported -- only (@{$self->{allowed_methods}}) for now"
406    );
407    $r->conn->close;
408    return;
409  }
410
411  # We need some way to decide if we should send static or dynamic
412  # content.
413  # To save users from having to re-implement (likely incorrectly)
414  # basic security checks like .. abuse in GET paths, we should provide
415  # a default implementation -- preferably one already on CPAN.
416  # Here's a way: ask the mapper.
417
418  if($self->{staticp}->($r)) {
419    $self->debug(3, "Sending static content... ");
420    $self->{adapter}->send_static($r);
421    $self->debug(3, "done sending static content.");
422    return;
423  }
424
425  # Right now, map takes one of our Continuity::RequestHolder objects (with conn and request set) and sets queue
426
427  # This actually finds the thing that wants it, and gives it to it
428  # (executes the continuation)
429  $self->debug(3, "Calling map... ");
430  $self->mapper->map($r);
431  $self->debug(3, "done mapping.");
432  $self->debug(2, "Done processing request, waiting for next\n");
433}
434
435=head2 $server->loop()
436
437Calls Coro::Event::loop and sets up session reaping. This never returns!
438
439=cut
440
441no warnings 'redefine';
442
443sub loop {
444  my ($self) = @_;
445
446  if($self->{adapter}->can('loop_hook')) {
447      return $self->{adapter}->loop_hook;
448  }
449
450  eval 'use Coro::Event';
451  $self->reaper;
452
453  Coro::Event::loop();
454}
455
456sub reaper {
457  # This is our reaper event. It looks for expired sessions and kills them off.
458  # TODO: This needs some documentation at the very least
459  # XXX hello?  configurable timeout?  hello?
460  my $self = shift;
461  async {
462    local $Coro::current->{desc} = 'Session Reaper';
463     my $timeout = 300;
464     $timeout = $self->{reap_after} if $self->{reap_after} and $self->{reap_after} < $timeout;
465     my $timer = Coro::Event->timer(interval => $timeout, );
466     while ($timer->next) {
467        $self->debug(3, "debug: loop calling reap");
468        $self->mapper->reap($self->{reap_after}) if $self->{reap_after};
469     }
470  };
471  # cede once to get the reaper running
472  cede;
473}
474
475# This is our internal debugging tool.
476# Call it with $self->Continuity::debug(2, '...');
477sub debug {
478  my ($self, $level, @msg) = @_;
479  my $output;
480  if($self->debug_level && $level <= $self->debug_level) {
481    if($level > 2) {
482      my ($package, $filename, $line) = caller;
483      $output .= "$package:$line: ";
484    }
485    $output .= "@msg";
486    $self->debug_callback->($output) if $self->can('debug_callback');
487  }
488}
489
490=head1 SEE ALSO
491
492See the Wiki for development information, more waxing philosophic, and links to
493similar technologies such as L<http://seaside.st/>.
494
495Website/Wiki: L<http://continuity.tlt42.org/>
496
497L<Continuity::Request>, L<Continuity::RequestCallbacks>, L<Continuity::Mapper>,
498L<Continuity::Adapt::HttpDaemon>, L<Coro>
499
500L<AnyEvent::DBI> and L<Coro::Mysql> for concurrent database access.
501
502=head1 AUTHOR
503
504  Brock Wilcox <awwaiid@thelackthereof.org> - http://thelackthereof.org/
505  Scott Walters <scott@slowass.net> - http://slowass.net/
506  Special thanks to Marc Lehmann for creating (and maintaining) Coro
507
508=head1 COPYRIGHT
509
510  Copyright (c) 2004-2014 Brock Wilcox <awwaiid@thelackthereof.org>. All
511  rights reserved.  This program is free software; you can redistribute it
512  and/or modify it under the same terms as Perl itself.
513
514=cut
515
5161;
517
518