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

Comparing cvsroot/AnyEvent-Porttracker/Porttracker.pm (file contents):
Revision 1.7 by root, Tue Nov 16 01:16:58 2010 UTC vs.
Revision 1.17 by root, Mon Mar 11 08:43:53 2013 UTC

… …
3AnyEvent::Porttracker - Porttracker/PortIQ API client interface. 3AnyEvent::Porttracker - Porttracker/PortIQ API client interface.
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::Porttracker; 7 use AnyEvent::Porttracker;
8
9 my $api = new AnyEvent::Porttracker
10 host => "10.0.0.1",
11 user => "admin",
12 pass => "31331",
13 tls => 1,
14 on_error => sub {
15 die $_[1];
16 },
17 ;
18
19 # Example 1
20 # a simple request: ping the server synchronously
21
22 my ($timestamp, $pid) = $api->req_sync ("ping");
23
24 # Example 2
25 # find all realms, start a discovery on all of them
26 # and wait until all discovery processes have finished
27 # but execute individual discoveries in parallel,
28 # asynchronously
29
30 my $cv = AE::cv;
31
32 $cv->begin;
33 # find all realms
34 $api->req (realm_info => ["gid", "name"], sub {
35 my ($api, @realms) = @_;
36
37 # start discovery on all realms
38 for my $realm (@realms) {
39 my ($gid, $name) = @$realm;
40
41 $cv->begin;
42 $api->req (realm_discover => $gid, sub {
43 warn "discovery for realm '$name' finished\n";
44 $cv->end;
45 });
46 }
47
48 $cv->end;
49 });
50
51 $cv->recv;
52
53 # Example 3
54 # subscribe to realm_poll_stop events and report each occurance
55
56 $api->req (subscribe => "realm_poll_stop", sub {});
57 $api->on (realm_poll_stop_event => sub {
58 my ($api, $gid) = @_;
59 warn "this just in: poll for realm <$gid> finished.\n";
60 });
61
62 AE::cv->recv; # wait forever
8 63
9=head1 DESCRIPTION 64=head1 DESCRIPTION
10 65
11Porttracker (L<http://www.porttracker.com/>) is a product that (among 66Porttracker (L<http://www.porttracker.com/>) is a product that (among
12other things) scans switches and routers in a network and gives a coherent 67other things) scans switches and routers in a network and gives a coherent
… …
42 97
43package AnyEvent::Porttracker; 98package AnyEvent::Porttracker;
44 99
45use common::sense; 100use common::sense;
46 101
102use Carp ();
47use Scalar::Util (); 103use Scalar::Util ();
48 104
49use AnyEvent (); 105use AnyEvent ();
50use AnyEvent::Handle (); 106use AnyEvent::Handle ();
51 107
52use MIME::Base64 (); 108use MIME::Base64 ();
53use Digest::HMAC_MD6 (); 109use Digest::HMAC_MD6 ();
54use JSON (); 110use JSON ();
55 111
56our $VERSION = '0.0'; 112our $VERSION = '1.01';
57 113
58sub call { 114sub call {
59 my ($self, $type, @args) = @_; 115 my ($self, $type, @args) = @_;
60 116
61 $self->{$type} 117 $self->{$type}
… …
108verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode 164verify => 1, verify_peername => [1, 1, 1] >> or whatever verification mode
109you wish to use. 165you wish to use.
110 166
111=item tls_ctx => $tls_ctx 167=item tls_ctx => $tls_ctx
112 168
113The L<AnyEvent::TLS> object to use. 169The L<AnyEvent::TLS> object to use. See C<tls>, above.
114
115#TODO#
116 170
117=item on_XYZ => $coderef 171=item on_XYZ => $coderef
118 172
119You can specify event callbacks either by subclassing and overriding the 173You can specify event callbacks either by sub-classing and overriding the
120respective methods or by specifying coderefs as key-value pairs when 174respective methods or by specifying code-refs as key-value pairs when
121constructing the object. 175constructing the object. You add or remove event handlers at any time with
176the C<event> method.
122 177
123=back 178=back
124 179
125=cut 180=cut
126 181
… …
128 my $class = shift; 183 my $class = shift;
129 184
130 my $self = bless { 185 my $self = bless {
131 id => "a", 186 id => "a",
132 ids => [], 187 ids => [],
133 queue => [], # ininitially queue everything 188 queue => [], # initially queue everything
134 @_, 189 @_,
135 }, $class; 190 }, $class;
136 191
137 { 192 {
138 Scalar::Util::weaken (my $self = $self); 193 Scalar::Util::weaken (my $self = $self);
… …
260 $_[0]{queue} 315 $_[0]{queue}
261 ? push @{ $_[0]{queue} }, [@_] 316 ? push @{ $_[0]{queue} }, [@_]
262 : &_req 317 : &_req
263} 318}
264 319
320=item @res = $api->req_sync ($type => @args)
321
322Similar to C<< ->req >>, but waits for the results of the request and on
323success, returns the values instead (without the success flag, and only
324the first value in scalar context). On failure, the method will C<croak>
325with the error message.
326
327=cut
328
329sub req_sync {
330 push @_, my $cv = AE::cv;
331 &req;
332 my ($ok, @res) = $cv->recv;
333
334 $ok
335 or Carp::croak $res[0];
336
337 wantarray ? @res : $res[0]
338}
339
265=item $api->req_failok ($type => @args, $callback->($api, $success, @reply)) 340=item $api->req_failok ($type => @args, $callback->($api, $success, @reply))
266 341
267Just like C<< ->req >>, with two differences: first, a failure will not 342Just like C<< ->req >>, with two differences: first, a failure will not
268raise an error, second, the initial status reply which indicates success 343raise an error, second, the initial status reply which indicates success
269or failure is not removed before calling the callback. 344or failure is not removed before calling the callback.
… …
272 347
273sub req_failok { 348sub req_failok {
274 $_[0]{queue} 349 $_[0]{queue}
275 ? push @{ $_[0]{queue} }, [@_] 350 ? push @{ $_[0]{queue} }, [@_]
276 : &_req 351 : &_req
352}
353
354=item $api->on (XYZ => $callback)
355
356Overwrites any currently registered handler for C<on_XYZ> or
357installs a new one. Or, when C<$callback> is undef, unregisters any
358currently-registered handler.
359
360Example: replace/set the handler for C<on_discover_stop_event>.
361
362 $api->on (discover_stop_event => sub {
363 my ($api, $gid) = @_;
364 ...
365 });
366
367=cut
368
369sub on {
370 my $self = shift;
371
372 while (@_) {
373 my ($event, $cb) = splice @_, 0, 2;
374 $event =~ s/^on_//;
375
376 $self->{"on_$event"} = $cb;
377 }
277} 378}
278 379
279sub on_start_tls_notify { 380sub on_start_tls_notify {
280 my ($self) = @_; 381 my ($self) = @_;
281 382
… …
379 480
380 $msg =~ s/\n$//; 481 $msg =~ s/\n$//;
381 $self->error ("login failed: $msg"); 482 $self->error ("login failed: $msg");
382} 483}
383 484
485sub on_event_notify {
486 my ($self, $event, @args) = @_;
487
488 call $self, "on_${event}_event", @args;
489}
490
384=back 491=back
385 492
386=head2 EVENTS 493=head1 EVENTS/CALLBACKS
387 494
388AnyEvent::Porttracker conenctions are fully event-driven, and naturally 495AnyEvent::Porttracker connections are fully event-driven, and naturally
389there are a number of events that can occur. All these events have a name 496there are a number of events that can occur. All these events have a name
390starting with C<on_> (example: C<on_login_failure>). 497starting with C<on_> (example: C<on_login_failure>).
391 498
392Programs can catch these events in two ways: either by providing 499Programs can catch these events in two ways: either by providing
393constructor arguments with the event name as key and a coderef as value: 500constructor arguments with the event name as key and a code-ref as value:
394 501
395 my $api = new AnyEvent::Porttracker 502 my $api = new AnyEvent::Porttracker
396 host => ..., 503 host => ...,
397 user => ..., pass => ..., 504 user => ..., pass => ...,
398 on_error => sub { 505 on_error => sub {
… …
400 warn $msg; 507 warn $msg;
401 exit 1; 508 exit 1;
402 }, 509 },
403 ; 510 ;
404 511
405Or by subclassing C<AnyEvent::Porttracker> and overriding methods of the 512Or by sub-classing C<AnyEvent::Porttracker> and overriding methods of the
406same name: 513same name:
407 514
408 package MyClass; 515 package MyClass;
409 516
410 use base AnyEvent::Porttracker; 517 use base AnyEvent::Porttracker;
… …
458 565
459=item on_start_tls_notify $api 566=item on_start_tls_notify $api
460 567
461Called when the server wants to start TLS negotiation. This is used 568Called when the server wants to start TLS negotiation. This is used
462internally and - while it is possible to override it - should not be 569internally and - while it is possible to override it - should not be
463overriden. 570overridden.
571
572=item on_event_notify $api, $eventname, @args
573
574Called when the server broadcasts an event the API object is subscribed
575to. The default implementation (which should not be overridden) simply
576re-issues an "on_eventname_event" event with the @args.
464 577
465=item on_XYZ_notify $api, ... 578=item on_XYZ_notify $api, ...
466 579
467In general, any protocol notification will result in an event of the form 580In general, any protocol notification will result in an event of the form
468C<on_NOTIFICATION_notify>. 581C<on_NOTIFICATION_notify>.
469 582
583=item on_XYZ_event $api, ...
584
585Called when the server broadcasts the named (XYZ) event.
586
470=back 587=back
471 588
472=head1 SEE ALSO 589=head1 SEE ALSO
473 590
474L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>. 591L<AnyEvent>, L<http://www.porttracker.com/>, L<http://www.infoblox.com/en/products/portiq.html>.
475 592
476=head1 AUTHOR 593=head1 AUTHOR
477 594
478 Marc Lehmann <marc@porttracker.net> 595 Marc Lehmann <marc@nethype.de>
479 596
480=cut 597=cut
481 598
4821 5991

Diff Legend

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