package Net::CDP::Manager;## $Id: Manager.pm,v 1.15 2005/07/22 02:44:01 mchapman Exp $#use strict;use Carp::Clan qw(^Net::CDP);use vars qw($VERSION @ISA $AUTOLOAD @EXPORT @EXPORT_OK %EXPORT_TAGS);$VERSION = (qw$Revision: 1.15 $)[1];require Exporter;@ISA = qw(Exporter);@EXPORT = qw(	CDP_LOOP_ABORT	cdp_ports	cdp_manage cdp_manage_hard cdp_manage_soft cdp_unmanage	cdp_managed cdp_hard cdp_soft cdp_active cdp_inactive	cdp_recv cdp_send	cdp_loop	cdp_template cdp_args);use Net::CDP;use Net::CDP::Packet;use Time::HiRes qw(gettimeofday);my %managed;my %hard;my $template = eval { new Net::CDP::Packet() } or confess $@;my %args = (promiscuous => 0);{	my $ref; $ref = \$ref;	use constant CDP_LOOP_ABORT => \$ref;}sub _clear_error() {	$@ = '';}sub _try_new_cdp(@) {	my $result = eval {		local $SIG{__DIE__};		new Net::CDP(@_);	};	_clear_error();	$result;}=head1 NAMENet::CDP::Manager - Cisco Discovery Protocol (CDP) manager=head1 SYNOPSIS  use Net::CDP::Manager;    # Available network ports  @ports = cdp_ports;    # Adding ports to manage  cdp_manage(@ports);      # default is hard ports only  cdp_manage_soft(@ports);    # Removing ports to manage  cdp_unmanage(@ports);    # Returning managed ports  @managed  = cdp_managed;  @soft     = cdp_soft;  @hard     = cdp_hard;  @active   = cdp_active;  @inactive = cdp_inactive;    # Receiving a CDP packet by any managed port  cdp_recv;    # Send a CDP packet on all managed ports  cdp_send;    # Loop and dispatch CDP packets to callback  sub callback { ($port, $packet) = @_; ... }  cdp_loop(\&callback);    # The template Net::CDP::Packet object  $template = cdp_template;  	  # Arguments used when creating Net::CDP objects  %args     = cdp_args;=head1 DESCRIPTIONThe Net::CDP::Manager module provides a simple interface to manage multiple CDPadvertiser/listeners (Net::CDP objects). With this module, CDP packets canbe received and sent over multiple network ports.Ports managed by this module are treated in one of two different ways. "Hard"ports must always exist -- if any errors occur while initializing the port,reading from it or writing to it, methods in this module will return an error."Soft" ports, on the other hand, ignore errors generated by the port. Thus thismodule can manage Each soft port is in one of two states. Ports on which the last receive or sendwas successful are deemed to be "active". Newly managed ports, or ports onwhich the last receive or send was unsuccessful are deemed to be "inactive".If you are upgrading code from an older version of Net::CDP, please read theL</"UPGRADING FROM PREVIOUS VERSIONS"> section below.=head1 FUNCTIONS=over=item B<cdp_ports>    @ports = cdp_ports;Returns a list of network ports that can be used by this module. This methodreturns exactly that returned by the L<Net::CDP::ports|Net::CDP/"ports"> classmethod.=cut*cdp_ports = \&Net::CDP::ports;sub _cdp_manage($@) {	my ($hard, @ports) = @_;	my @added;	my %add;		_clear_error();		foreach (@ports) {		next if exists $add{$_};		next if $hard && exists $managed{$_} && defined $managed{$_};		push @added, $_ unless exists $managed{$_};		$add{$_} = $hard ? new Net::CDP(port => $_, %args) : undef;	}		foreach (keys %add) {		$managed{$_} = $add{$_} unless $managed{$_};		$hard{$_} = $hard;	}		@added;}=item B<cdp_manage>    @added = cdp_manage(@ports)Adds the supplied network ports to the manager's list of managed ports. Returnsthe actual ports added, which may be fewer than provided if some ports arealready managed. In scalar context the number of ports added is returned. Ifany ports could not be initialized, this method croaks.Ports added by this function are hard -- that is, errors on them will generateerrors by the functions of this module.Any ports in C<@ports> that are already managed by this module are hardened ifthey are currently soft. These ports are I<not> in the list returned by thisfunction.=cutsub cdp_manage(@) { _cdp_manage(1, @_) }*cdp_manage_hard = \&cdp_manage;=item B<cdp_manage_soft>    @added = cdp_manage_soft(@ports)Adds the supplied network ports to the manager's list of managed ports. Returnsthe actual ports added, which may be fewer than provided if some ports arealready managed. In scalar context the number of ports added is returned.Ports added by this function are soft -- that is, errors on them will besilently ignored by the functions of this module.Any ports in C<@ports> that are already managed by this module are softened ifthey are currently hard. These ports are I<not> in the list returned by thisfunction.=cutsub cdp_manage_soft(@) { _cdp_manage(0, @_) }=item B<cdp_unmanage>    @removed = cdp_unmanage(@ports)Removes the supplied network ports from the manager's list of managed ports.Returns the actual ports removed, which may be fewer than provided if C<@ports>contains duplicates. In scalar context the number of ports removed is returned.=cutsub cdp_unmanage(@) {	my %removed;		_clear_error();		foreach (@_) {		next unless exists $removed{$_} || exists $managed{$_};		$removed{$_} = 1;	}		foreach (keys %removed) {		delete $managed{$_};		delete $hard{$_};	}		keys %removed;}=item B<cdp_managed>    @managed = cdp_managed()Returns the list of ports currently being managed. In scalar context the numberof ports is returned.=cutsub cdp_managed() { keys %managed }=item B<cdp_hard>    @hard = cdp_hard()Returns the list of hard ports currently being managed. In scalar context thenumber of hard ports is returned.=cutsub cdp_hard() { grep { $hard{$_} } keys %managed }=item B<cdp_soft>    @soft = cdp_soft()Returns the list of soft ports currently being managed. In scalar context thenumber of soft ports is returned.=cutsub cdp_soft() { grep { ! $hard{$_} } keys %managed }=item B<cdp_active>    @active = cdp_active()Returns the list of active ports currently being managed. In scalar context thenumber of active ports is returned.A port is active if it is hard, or if the last send or receive on the portsucceeded.=cutsub cdp_active() { grep { defined $managed{$_} } keys %managed }=item B<cdp_inactive>    @inactive = cdp_inactive()Returns the list of inactive ports currently being managed. In scalar contextthe number of inactive ports is returned.A port is inactive if it is soft and the last send or receive on the portfailed.=cutsub cdp_inactive() { grep { ! defined $managed{$_} } keys %managed }=item B<cdp_recv>    $packet                   = cdp_recv()    ($packet, $port, $remain) = cdp_recv($timeout)Returns the next available CDP packet on any managed port as aL<Net::CDP::Packet> object.If C<$timeout> is ommitted or undefined, this method will block until apacket is received or an error occurs. Otherwise, this method will wait for upto C<$timeout> seconds before returning. If no packets are received before thistimeout expires, an undefined value is returned.When evaluated in list context, this function also returns the port on whichthe packet was received and the time remaining out of the original timeout,or an undefined value if no original timeout was specified.If an error occurs on a hard port, this function croaks with an error message.For non-blocking operation, specify a timeout of 0.=cutsub cdp_recv(;$) {	my $remain = shift;		_clear_error();		my $packet;	my $port;	do {		my @ports;		my $rin = '';		foreach (keys %managed) {			my $cdp = ($managed{$_} ||= _try_new_cdp(port => $_, %args));			next unless $cdp;			my $fd = $cdp->_fd;			$ports[$fd] = $_;			vec($rin, $fd, 1) = 1;		}		my $start = gettimeofday;		my $count = select(my $rout = $rin, undef, undef, $remain);		croak "Select failed: $!" if $count < 0;				if ($count) {			my $diff = gettimeofday - $start;			if (defined $remain) {				$remain -= $diff;				$remain = 0 if $remain < 0;			}		} else {			# No fds -- timeout definitely expired			$remain = 0;		}				if ($count) {			foreach (0 .. $#ports) {				if (vec($rout, $_, 1)) {					confess "Select returned unexpected file descriptor $_"						unless defined $ports[$_];					$port = $ports[$_];					$packet = eval { $managed{$port}->recv(nonblock => 1); };					if ($@) {						croak "Port $port failed: $@"							if $hard{$port};						$managed{$port} = undef;					}					last if $packet;					$port = undef;				}			}		}	} until ($packet || (defined $remain && !$remain));	wantarray ? ($packet, $port, $remain) : $packet;}=item B<cdp_send>    @ports = cdp_send()Sends a CDP packet over all managed ports, and returns the ports on whichpackets were successfully sent. In scalar context the number of such ports isreturned.Internally, an appropriate packet is generated and sent for each port in turn.If an error occurs while generating or sending a packet for a hard port, thisfunction croaks. Note that in this case some packets for other ports may havealready been sent.Errors while generating or sending a packet for a soft port cause the port tobecome inactive. Other errors will cause this function to croak with anerror message.=cutsub cdp_send() {	my @successful;		_clear_error();		foreach (keys %managed) {		my $cdp = ($managed{$_} ||= _try_new_cdp(port => $_, %args));		next unless $cdp;		my $packet = clone $template;		$packet->addresses([$cdp->addresses]);		$packet->port($cdp->port);		my $bytes = eval { $cdp->send($packet) };		if ($bytes) {			push @successful, $_;			next;		}		unless (defined $bytes) {			croak "Port $_ failed: $@"				if $hard{$_};			$managed{$_} = undef;		}	}	@successful;}=item B<cdp_loop>    $count = cdp_loop(\&callback)    $count = cdp_loop(\&callback, $timeout)Enters a loop to continually process received packets from managed ports anddispatches them to the specified callback function. Returns the number ofpackets processed.Upon receiving each packet C<callback> is called with the following threeparameters:=over=item 1.The packet, as a L<Net::CDP::Packet> object;=item 2.The port on which the packet was received; and=item 3.If C<$timeout> was specified, the time remaining time out of the originaltimeout, otherwise an undefined value.=backThe third parameter may be modified in-place, and C<cdp_loop> will use it asa new time remaining.It is safe for the callback function to call any function in Net::CDP::Manager,including L</"cdp_recv"> or L</"cdp_loop">. It is also safe for the callbackfunction to modify the packet template through L</"cdp_template">.The C<cdp_loop> function will continue processing packets until:=over=item 1.C<callback> returns the special value CDP_LOOP_ABORT;=item 2.If C<$timeout> was specified, the timeout expires; or=backIf an error occurs on a hard port, this function croaks with an error message.When an error is detected on a soft port, it is deactivated for up to 30seconds. No errors are generated by this function in this case.Note that if C<$timeout> is not specified and the callback function doesnot modify its third argument, this function may never exit.=cutsub cdp_loop(&;$) {	my $callback = shift;	croak "Invalid callback"		unless defined $callback && ref $callback eq 'CODE';	my $remain = shift;		_clear_error();		my $count = 0;	{ do {		# All of this is so that cdp_recv will never block		# for more than 30 seconds. That way soft ports can		# recover from errors relatively quickly.		my $start = defined $remain			? ($remain > 30 ? 30 : $remain)			: 30;		my ($packet, $port, $end) = cdp_recv($start);		$remain -= $start - $end if defined $remain;		if ($packet) {			$count++;			my $result = $callback->($packet, $port, $remain);			last if defined $result && $result == CDP_LOOP_ABORT;		}	} while (!defined $remain || $remain); }	$count;}=item B<cdp_template>    $template = cdp_template()    $template = cdp_template($new_template)Returns the current template L<Net::CDP::Packet> object. If C<$new_template> issupplied and defined, the template will be updated first.The template L<Net::CDP::Packet> object is used by L</"cdp_send"> to generateport-specific packets to send. For each managed port L</"cdp_send"> clones thetemplate, fills in the L<addresses|Net::CDP::Packet/"addresses"> andL<port|Net::CDP::Packet/"port"> fields with data relevant to the port, thensends the packet via the port.The object returned by C<cdp_template> may be manipulated directly. Note,however, that the C<port> and C<addresses> fields will always be ignored byL</"cdp_send">.=cutsub cdp_template(;$) {	my $new_template = shift;	if (defined $new_template) {		croak "Invalid new template"			unless ref $new_template eq 'Net::CDP::Packet';		$template = $new_template;	}	$template;}=item B<cdp_args>    %args = cdp_args(                [ promiscuous => $promiscuous, ] # default = 0            )Returns the current settings this module will use when creating L<Net::CDP>objects.This method allows you to change the default values for a subset of thearguments allowed in the L<Net::CDP/"new"> method. Currently, the only argumentpermitted is C<promiscuous>.This function replaces the C<cdp_flags> function from previous versions ofNet::CDP::Manager. Do not use the C<cdp_flags> function -- replace it withcalls to C<cdp_args> instead.=cutsub cdp_args(;@) {	my @allowed = qw(promiscuous);		my %temp = Net::CDP::_parse_args \@_, @allowed;	$args{$_} = $temp{$_} foreach keys %temp;	%args;}sub cdp_flags($) {	Net::CDP::_deprecated;	cdp_args promiscuous => (shift() & Net::CDP::CDP_PROMISCUOUS());}=back=head1 EXAMPLESA typical application could have the following form:  use Net::CDP::Manager;  # Callback to process each packet.  sub callback {    my ($packet, $port) = @_;    print "Received packet on $port from ", $packet->device, "\n";  }    # Manage all available ports.  cdp_manage(cdp_ports);    # Send a packet every minute. Pass received packets to callback.  while (1) {    cdp_send;    cdp_loop(\&callback, 60);  }=head1 SEE ALSOL<Net::CDP>, L<Net::CDP::Packet>=head1 AUTHORMichael Chapman, E<lt>cpan@very.puzzling.orgE<gt>=head1 COPYRIGHT AND LICENSECopyright (C) 2005 by Michael Chapmanlibcdp is released under the terms and conditions of the GNU Library GeneralPublic License version 2. Net::CDP may be redistributed and/or modified underthe same terms as Perl itself.=cut1;