File Coverage

blib/lib/Hoppy.pm
Criterion Covered Total %
statement 106 164 64.6
branch 14 42 33.3
condition 11 23 47.8
subroutine 24 29 82.7
pod 9 9 100.0
total 164 267 61.4


line stmt bran cond sub pod time code
1             package Hoppy;
2 7     7   4878 use strict;
  7         13  
  7         244  
3 7     7   41 use warnings;
  7         14  
  7         190  
4 7     7   22621 use EV;
  7         31516  
  7         227  
5 7     7   9767 use POE;
  7         76716  
  7         251  
6 7     7   648664 use POE::Sugar::Args;
  7         97109  
  7         64  
7 7     7   8653 use POE::Filter::Line;
  7         33027  
  7         240  
8 7     7   20351 use POE::Component::Server::TCP;
  7         241087  
  7         813  
9 7     7   6320 use Hoppy::TCPHandler;
  7         22  
  7         45  
10 7     7   7413 use UNIVERSAL::require;
  7         16724  
  7         74  
11 7     7   201 use Carp;
  7         16  
  7         397  
12 7     7   35 use base qw(Hoppy::Base);
  7         16  
  7         12719  
13              
14             __PACKAGE__->mk_accessors($_) for qw(handler formatter service hook room);
15              
16             our $VERSION = '0.01005';
17              
18             sub new {
19 6     6 1 3978 my $class = shift;
20 6         237 my $self = $class->SUPER::new(@_);
21 6         44 $self->_setup;
22 6         467 return $self;
23             }
24              
25             sub start {
26 6     6 1 20764 my $self = shift;
27 6 50       35 if ( my $hook = $self->hook->{start} ) {
28 0         0 $hook->work();
29             }
30 6         87 POE::Kernel->run;
31             }
32              
33             sub stop {
34 6     6 1 1042811 my $self = shift;
35 6 50       35 if ( my $hook = $self->hook->{stop} ) {
36 0         0 $hook->work();
37             }
38 6         87 POE::Kernel->stop;
39             }
40              
41             sub dispatch {
42 1     1 1 2 my $self = shift;
43 1         2 my $in_data = shift;
44 1         2 my $poe = shift;
45 1         6 my $session_id = $poe->session->ID;
46 1         8 my $method = $in_data->{method};
47 1 50       5 if ( $method eq 'login' ) {
    0          
48 1         4 my $args = { in_data => $in_data, poe => $poe };
49 1         6 $self->service->{login}->work($args);
50             }
51             elsif ( $self->{not_authorized}->{$session_id} ) {
52 0         0 my $message = "not authorized. you have to login()";
53 0         0 my $out_data = { result => "", "error" => $message };
54 0         0 my $serialized = $self->formatter->serialize($out_data);
55 0         0 $self->handler->{Send}->do_handle( $poe, $serialized );
56             }
57             else {
58 0         0 my $user = $self->room->fetch_user_from_session_id($session_id);
59 0 0       0 return unless $user;
60 0         0 my $user_id = $user->user_id;
61 0         0 my $args = { user_id => $user_id, in_data => $in_data, poe => $poe };
62 0         0 eval { $self->service->{$method}->work($args) };
  0         0  
63             }
64             }
65              
66             sub unicast {
67 1     1 1 3 my $self = shift;
68 1         2 my $args = shift;
69 1         3 my $user_id = $args->{user_id};
70 1         2 my $message = $args->{message};
71 1         3 my $session_id = $args->{session_id};
72 1         2 eval {
73 1 50 33     5 if ( !$session_id and $user_id )
74             {
75 0         0 my $user = $self->room->fetch_user_from_user_id($user_id);
76 0         0 $session_id = $user->session_id;
77             }
78 1         7 $poe_kernel->post( $session_id => "Send" => $message );
79             };
80             }
81              
82             sub multicast {
83 0     0 1 0 my $self = shift;
84 0         0 my $args = shift;
85 0         0 my $sender = $args->{sender};
86 0         0 my $message = $args->{message};
87 0         0 my $room_id = $args->{room_id};
88 0         0 my $users = $self->room->fetch_users_from_room_id($room_id);
89 0         0 for my $user (@$users) {
90 0         0 my $session_id = $user->session_id;
91 0 0 0     0 if ( $sender and $session_id != $sender ) {
92 0         0 $poe_kernel->post( $session_id => "Send" => $message );
93             }
94             }
95             }
96              
97             sub broadcast {
98 0     0 1 0 my $self = shift;
99 0         0 my $args = shift;
100 0         0 my $sender = $args->{sender};
101 0         0 my $message = $args->{message};
102 0         0 for my $session_id ( keys %{ $self->{sessions} } ) {
  0         0  
103 0 0 0     0 if ( $sender and $session_id != $sender ) {
104 0         0 $poe_kernel->post( $session_id => "Send" => $message );
105             }
106             }
107             }
108              
109             sub regist_service {
110 0     0 1 0 my $self = shift;
111 0         0 while (@_) {
112 0         0 my $label = shift @_;
113 0         0 my $class = shift @_;
114 0 0       0 unless ( ref($class) ) {
115 0 0       0 $class->require or die $@;
116 0         0 my $obj = $class->new( context => $self );
117 0         0 $self->service->{$label} = $obj;
118             }
119             else {
120 0         0 $self->service->{$label} = $class;
121             }
122             }
123             }
124              
125             sub regist_hook {
126 0     0 1 0 my $self = shift;
127 0         0 while (@_) {
128 0         0 my $label = shift @_;
129 0         0 my $class = shift @_;
130 0 0       0 unless ( ref($class) ) {
131 0 0       0 $class->require or die $@;
132 0         0 my $obj = $class->new( context => $self );
133 0         0 $self->hook->{$label} = $obj;
134             }
135             else {
136 0         0 $self->hook->{$label} = $class;
137             }
138             }
139             }
140              
141             sub _setup {
142 6     6   16 my $self = shift;
143 6         63 $self->_load_classes;
144 6         170 my $filter = POE::Filter::Line->new( Literal => "\x00" );
145 6 50 66     529 if ( $self->config->{test} and $self->config->{test} == 1 ) {
    100 66        
146 0         0 $filter = undef;
147             }
148             elsif ( $self->config->{test} and $self->config->{test} == 2 ) {
149 1 50       144 Hoppy::TestFilter->require or croak $@;
150 1         15 $filter = Hoppy::TestFilter->new($self);
151             }
152              
153             POE::Component::Server::TCP->new(
154             Alias => $self->config->{alias} || 'xmlsocketd',
155             Port => $self->config->{port} || 10000,
156 1     1   950107 ClientConnected => sub { $self->_tcp_handle( Connected => @_ ) },
157 1     1   198 ClientInput => sub { $self->_tcp_handle( Input => @_ ) },
158 1     1   441 ClientDisconnected => sub { $self->_tcp_handle( Disconnected => @_ ) },
159 1     1   4200 ClientError => sub { $self->_tcp_handle( Error => @_ ) },
160              
161             ClientFilter => $filter,
162             InlineStates => {
163             Send => sub {
164 1     1   139 $self->_tcp_handle( Send => @_ );
165             },
166             },
167 6   100     450 );
      100        
168 6     0   19779 POE::Kernel->sig( INT => sub { POE::Kernel->stop } );
  0         0  
169             }
170              
171             sub _load_classes {
172 6     6   12 my $self = shift;
173              
174             # tcp handler
175             {
176 6         12 $self->handler( {} );
  6         62  
177 6         144 for (qw(Input Connected Disconnected Error Send)) {
178 30         191 my $class = __PACKAGE__ . '::TCPHandler::' . $_;
179 30         365 $self->handler->{$_} = $class->new( context => $self );
180             }
181             }
182              
183             # io formatter
184             {
185 6   50     53 my $class = $self->config->{Formatter}
  6         210  
186             || __PACKAGE__ . '::Formatter::JSON';
187 6 50       960 $class->require or croak $@;
188 6         443 $self->formatter( $class->new( context => $self ) );
189             }
190              
191             # default service
192             {
193 6         107 $self->service( {} );
  6         32  
194 6         73 my @services = (
195             { login => __PACKAGE__ . '::Service::Login' },
196             { logout => __PACKAGE__ . '::Service::Logout' },
197             );
198 6 100       43 if ( $self->config->{regist_services} ) {
199 1         39 while ( my ( $key, $value ) =
  2         8  
200             each %{ $self->config->{regist_services} } )
201             {
202 1         30 push @services, { $key => $value };
203             }
204             }
205 6         248 for (@services) {
206 13         95 my ( $label, $class ) = %$_;
207 13 50       133 $class->require or croak $@;
208 13         617 $self->service->{$label} = $class->new( context => $self );
209             }
210             }
211              
212             # default hook
213             {
214 6         67 $self->hook( {} );
  6         34  
215 6         100 my @hooks = ();
216 6 50       52 if ( $self->config->{regist_hooks} ) {
217 0         0 while ( my ( $key, $value ) =
  0         0  
218             each %{ $self->config->{regist_hooks} } )
219             {
220 0         0 push @hooks, { $key => $value };
221             }
222             }
223 6         225 for (@hooks) {
224 0         0 my ( $label, $class ) = %$_;
225 0 0       0 $class->require or croak $@;
226 0         0 $self->hook->{$label} = $class->new( context => $self );
227             }
228             }
229              
230             # room
231             {
232 6   50     13 my $class = $self->config->{Room}
  6         28  
233             || __PACKAGE__ . '::Room::Memory';
234 6 50       239 $class->require or croak $@;
235 6         435 $self->room( $class->new( context => $self ) );
236             }
237             }
238              
239             sub _tcp_handle {
240 5     5   10 my $self = shift;
241 5         21 my $handler_name = shift;
242 5         62 my $poe = POE::Sugar::Args->new(@_);
243 5         94 $self->handler->{$handler_name}->do_handle($poe);
244             }
245              
246             1;
247             __END__