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__ |