File Coverage

blib/lib/POE/Component/XUL.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package POE::Component::XUL;
2              
3 1     1   217251 use XUL::Node;
  0            
  0            
4             use XUL::Node::Server;
5             use POE qw(Session XUL::SessionManager XUL::Session);
6             use Carp qw(croak);
7              
8             our $VERSION = '0.02';
9              
10             sub spawn {
11             my ($class, $args) = @_;
12              
13             $args->{port} = $args->{port} || '8077';
14             $args->{root} = $args->{root} || '/usr/local/xul-node';
15             $args->{apps} = {} if (!defined $args->{apps});
16             $args->{opts} = {} if (!defined $args->{opts});
17              
18             unless (ref($args->{apps}) eq 'HASH') {
19             croak "apps parameter must be a hash ref";
20             }
21             unless (ref($args->{opts}) eq 'HASH') {
22             croak "opts parameter must be a hash ref";
23             }
24             foreach (keys %{$args->{apps}}) {
25             if (ref($args->{apps}->{$_}) ne 'CODE') {
26             croak "apps parameter $_ must be a code reference (callback or sub)";
27             }
28             }
29              
30             POE::Session->create(
31             heap => $args,
32             package_states => [
33             eval { __PACKAGE__ } => [ qw( _start session_timeout ) ],
34             ],
35             );
36             }
37              
38             sub _start {
39             my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
40              
41             $kernel->alias_set('poe_xul');
42            
43             # new server obj, with a friendlier session manager
44             $heap->{server} = bless({
45             session_manager => POE::XUL::SessionManager->new(apps => $heap->{apps}, opts => $heap->{opts}),
46             disable_root => $heap->{disable_root},
47             }, 'XUL::Node::Server');
48              
49             $heap->{server}->create_http_server_component($heap->{port},$heap->{root});
50             $heap->{server}->{session_timer} = XUL::Node::Server::SessionTimer->new(
51             $session->callback('session_timeout')
52             );
53             }
54              
55             sub session_timeout {
56             my ($kernel, $heap, $sn) = (@_[KERNEL, HEAP], $_[ARG1]->[0]);
57             if (defined($heap->{session_timeout}) && ref($heap->{session_timeout}) eq 'CODE') {
58             #no strict 'refs';
59             $heap->{session_timeout}->(splice(@_,ARG0));
60             #use strict 'refs';
61             }
62             $heap->{server}->timeout_session($sn);
63             }
64              
65             1;
66              
67             __END__