view release on metacpan or  search on metacpan

lib/Agent/TCLI/Control.pm  view on Meta::CPAN

    my ($self, $cmd, $package) = @_;
	$self->Verbose( "RegisterCommand: ".$cmd->name."  " );

	# Set a default package if not defined.
	$package = defined($package) ? $package."::".$cmd->name :
		'Control'."::".$cmd->name;

	if ( defined( $registered_commands[$$self]{'registered'}{ $package }) )
	{
		# We could die here, but then one would have to iterate over each failure
		# Though it might be nice to make failure more apparent. A MOTD perhaps?
		$self->Verbose( "RegisterCommand: ".$cmd->name." already registered! ",0 );
		$self->Verbose( "RegisterCommand: registered_commands dump  ",1,$self->registered_commands );
	}
	else
	{
		# need to figure out a way to do a reverse lookup on the name...
		$registered_commands[$$self]{'registered'}{ $package } = $cmd;
		$self->RegisterContexts($cmd);
	}

lib/Agent/TCLI/Transport/Base.pm  view on Meta::CPAN

	}
}

=item PackRequest

This object method is used by transports to prepare a request for transmssion.

Currently the code is taking a lazy approach and using Perl's YAML and OIO->dump to
safely freeze and thaw the request/responses for Internet transport.
By standardizing these routines in the Base class, more elegant methods
may be transparently enabled in the future.

=cut
# TODO review XEP on this, esp version numbers and best practices.

sub PackRequest {
	my ($self, $request) = @_;
	my $dump = $request->dump();

	# Take out the Base to save space since we're ignore this at the other end.
	delete $dump->[1]{'Agent::TCLI::Base'};

t/TCLI.User.t  view on Meta::CPAN

				  protocol =>  $hash->{'protocol'},   		# optional regex for protocol
				  auth	   =>  $hash->{'auth'},   # option regex for auth
				}), qr($hash->{'user1'}) , 'user1 not_auth against '.$hash->{'msg'} );
like( $user2->not_authorized(
				{ id	   =>  $hash->{'id'},   # user id. Will strip off resource
				  protocol =>  $hash->{'protocol'},   		# optional regex for protocol
				  auth	   =>  $hash->{'auth'},   # option regex for auth
				}), qr($hash->{'user2'}), 'user2 not_auth against '.$hash->{'msg'} );
} #end foreach auths

# This crashes. Apparently Params::Validate on fail doesn't capture it.
#ok(  $user1->not_authorized(
#				{ id	   =>  'user1@example.com',   # user id. Will strip off resource
#				  protocol =>  qr(jabber),   		# optional regex for protocol
#				  auth	   =>  qr(read only),   # option regex for auth
#				  msg	   =>  'user1',
#				}), 'user1 exact but with extra param' );