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 NAME

Net::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 DESCRIPTION

The Net::CDP::Manager module provides a simple interface to manage multiple CDP
advertiser/listeners (Net::CDP objects). With this module, CDP packets can
be 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 this
module can manage 

Each soft port is in one of two states. Ports on which the last receive or send
was successful are deemed to be "active". Newly managed ports, or ports on
which 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 the
L</"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 method
returns exactly that returned by the L<Net::CDP::ports|Net::CDP/"ports"> class
method.

=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. Returns
the actual ports added, which may be fewer than provided if some ports are
already managed. In scalar context the number of ports added is returned. If
any ports could not be initialized, this method croaks.

Ports added by this function are hard -- that is, errors on them will generate
errors by the functions of this module.

Any ports in C<@ports> that are already managed by this module are hardened if
they are currently soft. These ports are I<not> in the list returned by this
function.

=cut

sub 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. Returns
the actual ports added, which may be fewer than provided if some ports are
already managed. In scalar context the number of ports added is returned.

Ports added by this function are soft -- that is, errors on them will be
silently ignored by the functions of this module.

Any ports in C<@ports> that are already managed by this module are softened if
they are currently hard. These ports are I<not> in the list returned by this
function.

=cut

sub 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.

=cut

sub 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 number
of ports is returned.

=cut

sub cdp_managed() { keys %managed }

=item B<cdp_hard>

    @hard = cdp_hard()

Returns the list of hard ports currently being managed. In scalar context the
number of hard ports is returned.

=cut

sub 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 the
number of soft ports is returned.

=cut

sub 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 the
number of active ports is returned.

A port is active if it is hard, or if the last send or receive on the port
succeeded.

=cut

sub 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 context
the number of inactive ports is returned.

A port is inactive if it is soft and the last send or receive on the port
failed.

=cut

sub 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 a
L<Net::CDP::Packet> object.

If C<$timeout> is ommitted or undefined, this method will block until a
packet is received or an error occurs. Otherwise, this method will wait for up
to C<$timeout> seconds before returning. If no packets are received before this
timeout expires, an undefined value is returned.

When evaluated in list context, this function also returns the port on which
the 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.

=cut

sub 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 which
packets were successfully sent. In scalar context the number of such ports is
returned.

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, this
function croaks. Note that in this case some packets for other ports may have
already been sent.

Errors while generating or sending a packet for a soft port cause the port to
become inactive. Other errors will cause this function to croak with an
error message.

=cut

sub 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 and
dispatches them to the specified callback function. Returns the number of
packets processed.

Upon receiving each packet C<callback> is called with the following three
parameters:

=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 original
timeout, otherwise an undefined value.

=back

The third parameter may be modified in-place, and C<cdp_loop> will use it as
a 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 callback
function 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

=back

If 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 30
seconds. No errors are generated by this function in this case.

Note that if C<$timeout> is not specified and the callback function does
not modify its third argument, this function may never exit.

=cut

sub 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> is
supplied and defined, the template will be updated first.

The template L<Net::CDP::Packet> object is used by L</"cdp_send"> to generate
port-specific packets to send. For each managed port L</"cdp_send"> clones the
template, fills in the L<addresses|Net::CDP::Packet/"addresses"> and
L<port|Net::CDP::Packet/"port"> fields with data relevant to the port, then
sends 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 by
L</"cdp_send">.

=cut

sub 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 the
arguments allowed in the L<Net::CDP/"new"> method. Currently, the only argument
permitted is C<promiscuous>.

This function replaces the C<cdp_flags> function from previous versions of
Net::CDP::Manager. Do not use the C<cdp_flags> function -- replace it with
calls to C<cdp_args> instead.

=cut

sub 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 EXAMPLES

A 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 ALSO

L<Net::CDP>, L<Net::CDP::Packet>

=head1 AUTHOR

Michael Chapman, E<lt>cpan@very.puzzling.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005 by Michael Chapman

libcdp is released under the terms and conditions of the GNU Library General
Public License version 2. Net::CDP may be redistributed and/or modified under
the same terms as Perl itself.

=cut

1;