ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-Porttracker/Porttracker.pm
(Generate patch)

Comparing AnyEvent-Porttracker/Porttracker.pm (file contents):
Revision 1.3 by root, Mon Nov 15 19:49:36 2010 UTC vs.
Revision 1.4 by root, Mon Nov 15 20:41:17 2010 UTC

… …
58 : ($type = (UNIVERSAL::can $self, $type)) 58 : ($type = (UNIVERSAL::can $self, $type))
59 ? $type->($self, @args) 59 ? $type->($self, @args)
60 : () 60 : ()
61} 61}
62 62
63=item new AnyEvent::Porttracker [key => value...] 63=item $api = new AnyEvent::Porttracker [key => value...]
64 64
65Creates a new porttracker API connection object and tries to connect to 65Creates a new porttracker API connection object and tries to connect to
66the specified host (see below). After the connection has been established, 66the specified host (see below). After the connection has been established,
67the TLS handshake (if requested) will take place, followed by a login 67the TLS handshake (if requested) will take place, followed by a login
68attempt using either the C<none>, C<login_cram_md6> or C<login> methods, 68attempt using either the C<none>, C<login_cram_md6> or C<login> methods,
… …
107sub new { 107sub new {
108 my $class = shift; 108 my $class = shift;
109 109
110 my $self = bless { 110 my $self = bless {
111 id => "a", 111 id => "a",
112 ids => [],
112 queue => [], # ininitially queue everything 113 queue => [], # ininitially queue everything
113 @_, 114 @_,
114 }, $class; 115 }, $class;
115 116
116 { 117 {
… …
138 139
139 if (defined $id) { 140 if (defined $id) {
140 my $cb = delete $self->{cb}{$id} 141 my $cb = delete $self->{cb}{$id}
141 or return $self->error ("received unexpected reply msg with id $id"); 142 or return $self->error ("received unexpected reply msg with id $id");
142 143
144 push @{ $self->{ids} }, $id;
145
143 $cb->($self, @$msg); 146 $cb->($self, @$msg);
144 } else { 147 } else {
145 $msg->[0] = "on_$msg->[0]_notify"; 148 $msg->[0] = "on_$msg->[0]_notify";
146 call $self, @$msg; 149 call $self, @$msg;
147 } 150 }
… …
170 173
171sub _req { 174sub _req {
172 my $self = shift; 175 my $self = shift;
173 my $cb = pop; 176 my $cb = pop;
174 177
175 my $id = ++$self->{id}; 178 my $id = (pop @{ $self->{ids} }) || $self->{id}++;
176 179
177 unshift @_, $id; 180 unshift @_, $id;
178 $self->{cb}{$id} = $cb; 181 $self->{cb}{$id} = $cb;
179 182
180 my $msg = JSON::encode_json \@_; 183 my $msg = JSON::encode_json \@_;
181 184
182 $self->{hdl}->push_write ($msg); 185 $self->{hdl}->push_write ($msg);
183} 186}
187
188=item $api->req ($type => @args, $callback->($api, @args))
189
190Sends a generic request of type C<$type> to the server. When the server
191responds, the API object and the response arguments are passed to the
192callback, which is the last argument to this method.
193
194It is permissible to call this (or any other request function) at any
195time, even before the connection has been established - the API object
196always waits until after login before it actually sends the requests, and
197queues them until then.
198
199Example: ping the porttracker server.
200
201 $api->req ("ping", sub {
202 my ($api, $ok, $timestamp, $pid) = @_;
203 ...
204 });
205
206Example: determine the product ID.
207
208 $api->req (product_id => sub {
209 my ($api, $ok, $branding, $product_id) = @_;
210 ...
211 });
212
213Example: set a new license.
214
215 $api->req (set_license => $LICENSE_STRING, sub {
216 my ($api, $ok) = @_;
217
218 $ok or die "failed to set license";
219 });
220
221=cut
184 222
185sub req { 223sub req {
186 $_[0]{queue} 224 $_[0]{queue}
187 ? push @{ $_[0]{queue} }, [@_] 225 ? push @{ $_[0]{queue} }, [@_]
188 : &_req 226 : &_req

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines