File Coverage

blib/lib/App/Betting/Toolkit/Client.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package App::Betting::Toolkit::Client;
2              
3 1     1   37793 use 5.006;
  1         5  
  1         51  
4 1     1   6 use strict;
  1         2  
  1         35  
5 1     1   6 use warnings;
  1         15  
  1         35  
6              
7 1     1   700 use App::Betting::Toolkit::GameState;
  0            
  0            
8              
9             use Data::Dumper;
10              
11             use POE qw(Component::Client::TCP Filter::Reference);
12              
13             =head1 NAME
14              
15             App::Betting::Toolkit::Client - Client to the App::Betting::Toolkit::Server
16              
17             =head1 VERSION
18              
19             Version 0.0202
20              
21             =cut
22              
23             our $VERSION = '0.0202';
24              
25             =head1 SYNOPSIS
26              
27             Provide an easy to use way of transporting your GameState objects to a central server over a network
28              
29             Perhaps a little code snippet.
30              
31             use App::Betting::Toolkit::Client;
32              
33             my $foo = App::Betting::Toolkit::Client->new();
34              
35             =head1 SUBROUTINES/METHODS
36              
37             =head2 new
38              
39             =over 1
40              
41             Create a new Betting Client, you need to specify a parent, a handler, a host and a port:
42              
43             $_[HEAP]->{client} = App::Betting::Toolkit::Client->new({
44             port => 10001,
45             host => 'my.bet.server.com',
46             parent => 'my_data_source',
47             handler => 'my_handler_on_data_source',
48             debug_handler => 'debug_server',
49             });
50              
51             =back
52              
53             =cut
54              
55             sub new {
56             my $class = shift;
57             my $args = shift;
58              
59             die "No handler or parent passed" if ( ( !$args->{handler} ) || (! $args->{parent} ) );
60              
61             my $self;
62              
63             # check the state of args:
64             # host / port / regmode / handler
65              
66             $args->{regmode} = 'anonymous' if (!$args->{regmode});
67             $args->{debug_handler} = 'debug_server' if (!$args->{debug_handler});
68              
69             $self->{service} = POE::Component::Client::TCP->new(
70             RemoteAddress => $args->{host},
71             RemotePort => $args->{port},
72             Filter => POE::Filter::Reference->new("Storable"),
73             Started => sub { $self->{myid} = $_[SESSION]->ID },
74             Connected => sub {
75             my ($heap,$kernel) = @_[HEAP,KERNEL];
76              
77             my $msg = { query=>'connected', data=>'' };
78              
79             if ($args->{regmode} eq 'anonymous') {
80             $heap->{server}->put( { query=>'register', method=>'anonymous' } );
81             } elsif ($args->{regmode} eq 'private') {
82             die "Implement me";
83             $heap->{server}->put( { query=>'register', method=>'private', keys=>[] } );
84             } else {
85             die "Reg mode must be anonymous or private and nothing else..";
86             }
87              
88             $kernel->post($args->{parent},$args->{handler},$msg);
89             },
90             ServerInput => sub {
91             my ($kernel,$heap,$input) = @_[KERNEL,HEAP,ARG0];
92              
93             my $req = $input;
94             my $pkt = { error=>1, msg=>"Could not handle server req", req=>$req };
95              
96             if ($req->{query} eq 'register') {
97             if (!$req->{error}) {
98             # Ok we need to know what design of GameState packets the server is expecting.
99             $kernel->yield('send_to_server',{ query=>'gamepacket', method=>'initial' });
100             return;
101             }
102             } elsif ($req->{query} eq 'gamepacket') {
103             # Ok we need to remember this.
104             $self->{gamepacket} = $req->{data};
105             # ok we have a copy of the gamepacket template so we are ready to roll; lets tell the client
106             $pkt = { query=>'ready', gamepacket=>$self->{gamepacket} };
107             }
108              
109             if (!$pkt->{error}) {
110             $pkt->{id} = $self->{id};
111             $kernel->yield('send_to_parent',$pkt);
112             }
113              
114             $kernel->post($args->{parent},$args->{debug_handler},$input);
115             },
116             InlineStates => {
117             send_to_parent => sub {
118             my ($kernel,$req) = @_[KERNEL,ARG0];
119             $kernel->post($args->{parent},$args->{handler},$req);
120             },
121             send_to_server => sub {
122             my ($kernel,$heap,$req) = @_[KERNEL,HEAP,ARG0];
123              
124             $heap->{server}->put( $req );
125             },
126             send => sub {
127             my ($kernel,$heap,$req) = @_[KERNEL,HEAP,ARG0];
128             $kernel->yield('send_to_server',$req);
129             },
130             },
131             );
132              
133             bless $self, $class;
134              
135             return $self;
136             }
137              
138             =head2 send
139              
140             =over 1
141              
142             Send a raw data packet over to the server, use with care!
143              
144             =back
145              
146             $object->send({ query=>'echo', data=>time });
147              
148             =cut
149              
150             sub send {
151             my $self = shift;
152             my $pkt = shift;
153              
154             POE::Kernel->post($self->{myid},'send',$pkt);
155             }
156              
157             =head2 sendMatch
158              
159             =over 1
160              
161             Send a GameState object over the wire to the connected server.
162              
163             =back
164              
165             $object->matchSend($gameState);
166              
167             =cut
168              
169             sub matchSend {
170             my $self = shift;
171             my $gameState = shift;
172              
173             POE::Kernel->post($self->{myid},'send',{ query=>'matchdata', data=>$gameState });
174             }
175              
176              
177             sub newState {
178             my $self = shift;
179              
180             my $return = App::Betting::Toolkit::GameState->load($self->{gamepacket});
181              
182             return $return;
183             }
184              
185              
186             =head1 AUTHOR
187              
188             Paul G Webster, C<< >>
189              
190             =head1 BUGS
191              
192             Please report any bugs or feature requests to C, or through
193             the web interface at L. I will be notified, and then you'll
194             automatically be notified of progress on your bug as I make changes.
195              
196              
197              
198              
199             =head1 SUPPORT
200              
201             You can find documentation for this module with the perldoc command.
202              
203             perldoc App::Betting::Toolkit::Client
204              
205              
206             You can also look for information at:
207              
208             =over 4
209              
210             =item * RT: CPAN's request tracker (report bugs here)
211              
212             L
213              
214             =item * AnnoCPAN: Annotated CPAN documentation
215              
216             L
217              
218             =item * CPAN Ratings
219              
220             L
221              
222             =item * Search CPAN
223              
224             L
225              
226             =back
227              
228              
229             =head1 ACKNOWLEDGEMENTS
230              
231              
232             =head1 LICENSE AND COPYRIGHT
233              
234             Copyright 2013 Paul G Webster.
235              
236             This program is distributed under the (Revised) BSD License:
237             L
238              
239             Redistribution and use in source and binary forms, with or without
240             modification, are permitted provided that the following conditions
241             are met:
242              
243             * Redistributions of source code must retain the above copyright
244             notice, this list of conditions and the following disclaimer.
245              
246             * Redistributions in binary form must reproduce the above copyright
247             notice, this list of conditions and the following disclaimer in the
248             documentation and/or other materials provided with the distribution.
249              
250             * Neither the name of Paul G Webster's Organization
251             nor the names of its contributors may be used to endorse or promote
252             products derived from this software without specific prior written
253             permission.
254              
255             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
256             "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
257             LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
258             A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
259             OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
260             SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
261             LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
262             DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
263             THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
264             (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
265             OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
266              
267              
268             =cut
269              
270             1; # End of App::Betting::Toolkit::Client