view release on metacpan or  search on metacpan

t/03_forward_stateless.t  view on Meta::CPAN

# -------------------------------------------------------------------------
package myLeg;
use base 'Net::SIP::Leg';
use Net::SIP::Debug;
use Net::SIP::Util 'invoke_callback';
use fields qw( outgoing_proxy );

sub new {
	my ($class,%args) = @_;
	my $p = delete $args{outgoing_proxy};
	my $self = $class->SUPER::new(%args);
	$self->{outgoing_proxy} = $p;
	return $self;
}

sub can_deliver_to {
	my $self = shift;
	my ($proto,$addr,$port) = do {
		if ( @_>1 ) {
			my %args = @_;
			@args{ qw/proto addr port/ }

t/testlib.pl  view on Meta::CPAN

############################################################################
package TestLeg;
use base 'Net::SIP::Leg';
use fields qw( can_deliver_to dump_incoming dump_outgoing );
use Net::SIP 'invoke_callback';

sub new {
	my ($class,%args) = @_;
	my @lfields = qw( can_deliver_to dump_incoming dump_outgoing );
	my %largs = map { $_ => delete $args{$_} } @lfields;
	my $self = $class->SUPER::new( %args );
	if ( my $ct = delete $largs{can_deliver_to} ) {
		$self->{can_deliver_to} = _parse_addr($ct);
	}
	%$self = ( %$self, %largs );
	return $self;
}
sub can_deliver_to {
	my $self = shift;
	my $spec = @_ == 1 ? _parse_addr( $_[0] ) : { @_ };
	my $ct = $self->{can_deliver_to};
	if ( $ct ) {
		foreach (qw( addr proto port )) {
			next if ! $spec->{$_} || ! $ct->{$_};
			return if $spec->{$_} ne $ct->{$_};
		}
	}
	return $self->SUPER::can_deliver_to( @_ );
}

sub _parse_addr {
	my $addr = shift;
	$addr =~m{^(?:(udp|tcp):)?([\w\.-]+)(?::(\d+))?$} || die $addr;
	return { proto => $1, addr => $2, port => $3 }
}

sub receive {
	my $self = shift;
	my @rv = $self->SUPER::receive(@_) or return;
	invoke_callback( $self->{dump_incoming},@rv );
	return @rv;
}

sub deliver {
	my ($self,$packet,$to,$callback) = @_;
	invoke_callback( $self->{dump_outgoing},$packet,$to );
	return $self->SUPER::deliver( $packet,$to,$callback );
}



1;