File Coverage

blib/lib/Net/Connection/Simple.pm

Criterion	Covered	Total	%
statement	9	31	29.0
branch	0	8	0.0
condition			n/a
subroutine	3	5	60.0
pod	2	2	100.0
total	14	46	30.4

package Net::Connection::Simple;

=head1 NAME

Net::Connection::Simple - Perl extension handling simple connection info within an application

=head1 SYNOPSIS

  use Net::Connection::Simple;
  my $c = Net::Connection::Simple->new(seenFirst => (time()-1800), seenLast => time());

  $c->protocols(Net::Protocol::Simple->new(protocol => tcp, layer => 4));
  $c->protocols(Net::Protocol::Simple->new(protocol => 'ip', layer => 3));
  $c->protocols(Net::Protocol::Simple->new(protocol => 'irc', layer => 7));

  $c->protocols({
  	1 => Net::Protocol::Simple->new(protocol => 6, layer => 4),
  	2 => Net::Protocol::Simple->new(protocol => 'ip', layer => 3),
  	3 => Net::Protocol::Simple->new(protocol => 'irc', layer => 7),
  });

  $c->protocols([
  	Net::Protocol::Simple->new(protocol => 6, layer => 4),
  	Net::Protocol::Simple->new(protocol => 'ip', layer => 3),
  	Net::Protocol::Simple->new(protocol => 'irc', layer => 7),
  ]);

=head1 DESCRIPTION

  This module created to handle simple information about connections.

=cut

use 5.008007;
use strict;
use warnings;

our $VERSION = '1.02';

=head1 OBJECT METHODS

=head2 new

Constructs the Connection object

Accepts:

  	protocols => [ARRAY|HASHREF|Net::Protocol::Simple]

=cut

sub new {
	my ($class,%data) = @_;
	my $self = {};
	bless($self,$class);
	$self->protocols($data{protocols});
	return $self;
}

=head2 protocols

Returns a HASHREF of the protocols composing the connection [See Net::Protocol::Simple] keyed by layer

Accepts:

  	HASHREF:
  		{ $key 	  => Net::Protocol::Simple(...),
  		  $key++  => Net::Protocol::Simple(...),
  		  $key++  => Net::Protocol::Simple(...),
  		}

  	ARRAY:
  		[
  		  Net::Protocol::Simple->new(...),
  		  Net::Protocol::Simple->new(...),
  		  Net::Protocol::Simple->new(...),
  		]

  	Net::Protocol::Simple:
  		Net::Protocol::Simple->new(protocol => 6, layer => 4)

=cut

sub protocols {
	my ($self,$v) = @_;
	if(defined($v)){
		for(ref($v)){
			if(/^HASH$/){
				foreach my $x (keys %$v){ $self->protocols($v->{$x});}
				last;
			}
			if(/^ARRAY$/){
				foreach my $x (@{$v}) { $self->protocols($x); }
				last;
			}
			if(/^Net::Protocol::Simple$/){
				$self->{_protocols}->{$v->layer()} = $v;
				last;
			}
			die('Protocols requires a Net::Protocol::Simple Obj to be passed!');
		}
	}
	return $self->{_protocols};
}

1;
__END__