view release on metacpan or  search on metacpan

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

package Agent::TCLI::Package::Base;
#
# $Id: Base.pm 62 2007-05-03 15:55:17Z hacker $
#
=head1 NAME

Agent::TCLI::Package::Base - Base object for other Agent::TCLI::Package objects

=head1 SYNOPSIS

Base object for Commands. May be used directly in a command collection
or may be extended for special functionality. Note that the Control and
Library will not recognize any class extension without also being modified.

=head1 DESCRIPTION

This needs much more elaboration. For now, please use the source
of existing command packages. I apologize for the inconvenience.

=head1 INTERFACE

=cut

use warnings;
use strict;
use Carp;
use Object::InsideOut qw(Agent::TCLI::Base);

use POE;
use Scalar::Util  qw(blessed looks_like_number);
use Getopt::Lucid;
use YAML::Syck;
use XML::Simple;
use File::ShareDir;
#use FormValidator::Simple;

$YAML::Syck::Headless = 1;
$YAML::Syck::SortKeys = 1;

our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: Base.pm 62 2007-05-03 15:55:17Z hacker $))[2];

=head2 ATTRIBUTES

The following attributes are accessible through standard accessor/mutator
methods unless otherwise noted

=over

=item name

The name of the package. This is the word that is used to refer to the package POE::Session.
B<name> should only contain SCALAR type values.

=cut
my @name		:Field
				:Arg('name'=>'name','default'=>'base')
				:Acc('name');

=item commands

An array of the command objects in this package.

=cut
my @commands	:Field
				:Arg('commands')
				:Get('commands')
				:Type('HASH');

=item parameters

A hash of the parameters used in this package. Often parameters are shared
accross individual commands, so they are defined within the Package.
They are refered to by each command in the package.
B<parameters> should only contain hash values.

=cut
my @parameters	:Field
				:Type('HASH')
				:Arg('parameters')
				:Get('parameters');

my @session 	:Field
				:Arg('session')
				:Get('session')
				:Weak;
#				:Type('POE::Session');

=item controls

A hash of hashes keyed on control for storing stuff.

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

sub GetWheel {
	my ($self, $id, $sp) = @_;
	return ( $wheels[$$self]->{$id}{'wheel'},
			 $wheels[$$self]->{$id}{'sender'},
			 $wheels[$$self]->{$id}{'postback'} )
		if (defined( $wheels[$$self]->{$id}{'wheel'}) && $sp );

	return ( $wheels[$$self]->{$id}{'wheel'} )
		if ( defined( $wheels[$$self]->{$id}{'wheel'} ) );

	return (0);
}

sub SetWheel {
	my ($self, $wheel) = @_;
	if ( ref($wheel) =~ /POE::Wheel/ )
	{
		$wheels[$$self]->{$wheel->ID}{'wheel'} = $wheel;
	}
	else # it is just a wheel ID
	{
		delete ($wheels[$$self]{$wheel}{'wheel'} );
		delete ($wheels[$$self]{$wheel} );
	}
	return
}

sub GetWheelKey {
	my ($self, $wheel, $key) = @_;
	if ( ref($wheel) =~ /POE::Wheel/ )
	{
		return ( $wheels[$$self]->{$wheel->ID}{$key} );
	}
	else
	{
		return ( $wheels[$$self]->{$wheel}{$key} );
	}
}

sub SetWheelKey {
	my ($self, $wheel, $key, $value) = @_;
	if ( ref($wheel) =~ /POE::Wheel/ )
	{
		$wheels[$$self]->{$wheel->ID}{$key} = $value;
	}
	else
	{
		$wheels[$$self]->{$wheel}{$key} = $value;
	}
	return 1;
}


# Input validation methods. Returns false or error message.
# These are all deprecated. Use Contraints and Command->Validator instead.

sub NotPosInt {
	my ($self,$value,$name,$set) = @_;
	$name = "Parameter" unless defined($name);
	return ('') unless (defined ($value) && $value ne '');
	return($name." is not a number: got '$value'  \n") unless (Scalar::Util::looks_like_number($value) );
    return($name." is not an integer: got '$value'  \n") unless(int($value) == $value);
    return($name." is not positive: got '$value'  \n") unless ( $value >= 0);
	if (defined($set))
	{
		$self->$name($value) 	if ($set eq 'set');

	}
	return ('');
}

sub NotNumeric {
	my ($self,$value,$name,$set) = @_;
	$name = "Parameter" unless defined($name);
	return ('') unless (defined ($value) && $value ne '');
	return($name." is not a number: got '$value' \n") unless (Scalar::Util::looks_like_number($value) );
	$self->$name($value) 	if ($set);
	return ('');
}

sub NotScalar {
	my ($self,$value,$name,$set) = @_;
	$name = "Parameter" unless defined($name);
	return ('') unless (defined ($value) && $value ne '');
	return($name." is not a scalar: got '$value'  \n") unless ( ref($value) eq '' || ref($value) eq 'SCALAR_REF' );
	$self->$name($value) 	if ($set);
	return ('');
}

sub NotRange {
	my ($self,$value,$name,$set) = @_;
	$name = "Parameter" unless defined($name);
	return ('') unless (defined ($value) && $value ne '');
	return($name." must contain only digits or ,-:  got '$value' \n") unless ( $value !~ /[^0-9,:-]/ );
    return($name." must only have positive numbers: got '$value'  \n") unless ($value !~ /^-/ && $value !~ /[,:]-/);
    return($name." has invalid ranges: got '$value' \n") unless ( $value !~ /\d+[-:]\d+[-:]\d+/ && $value !~ /^[,:]/ );
	$self->$name($value) 	if ($set);
	return ('');
}

sub NotRegex {
	my ($self,$value,$name,$set) = @_;
	$name = "Parameter" unless defined($name);
	return ('') unless (defined ($value) && $value ne '');
	return($name." is not a valid regex: got '$value' \n")
		unless ( ref ( $value ) eq 'Regexp' );
	$self->$name($value) 	if ($set);
	return ('');
}

sub NotType {
	my ($self,$value,$name,$ref,$set) = @_;
	$name = "Parameter" unless defined($name);
	$ref = (ref($ref) eq 'Regexp') ? $ref : qr($ref);
	return ('') unless (defined ($value) && $value ne '');
	return($name." is not a valid type: got '$value' \n")
		unless ( ref ( $value ) =~ $ref );
	$self->$name($value) 	if ($set);
	return ('');
}

sub NotWithin
{
  # Taken from Test::Data::Within v 0.0.x
  # Update accordingly.  :)
  my ($self, $value, $range) = @_;
  my $txt;

  return 1 unless (defined($value) && defined($range));
  if ($range =~ /,/)
  {
	  my @list = split /,/,$range;
	   foreach my $item (@list)
	   {
	     my $res = $self->NotWithin($value,$item);
		 return (0) unless $res;