Agent-TCLI
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
# We don't actualy set the controls context, but let change context do that.
# It will also inform the user of change.
# Post context back to sender (Control)
$kernel->call( $sender => 'ChangeContext' => $request, \@context );
$self->Verbose("establish_context: setting context to "
.join(' ',@context)." ",2);
}
=item show
This POE event handler is the default show for packages.
It will accept an argument for the setting to show. It will also take an
argument of all or * and show all settings.
The parameter must be defined in the show Command entry's parameters or it will
not be shown. There must also be a OIO Field defined with the same name.
One may write their own show method if this is not sufficient.
One must still define the show Command within one's package to use this. One
must also load the show event handler in the Package's session.
=cut
sub show {
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
$self->Verbose("show: request(".$request->id.") ",2);
my ($txt, $code, $what, $var);
# calling with show as a command, that is the handler for show is show.
if ( $request->command->[0] eq 'show' ) # cmd1 show arg
# cmd1 attacks show <arg>
{
$what = $request->args->[0];
}
$self->Verbose("show: what(".$what.") request->args",1,$request->args);
ATTR: foreach my $attr ( keys %{ $self->commands->{'show'}->parameters } )
{
if ( $what eq $attr || $what =~ qr(^(\*|all)$))
{
if ( $self->can( $attr ) && defined( $self->$attr) )
{
my $ref = ref($self->$attr);
my $show = ( defined($self->parameters ) &&
defined($self->parameters->{ $attr } ) &&
defined($self->parameters->{ $attr }->show_method ) )
? $self->parameters->{ $attr }->show_method
: '';
$self->Verbose("show attr($attr) ref($ref) show($show)",1);
# simple scalar
if ( not $ref)
{
$txt .= "$attr: ".$self->$attr." \n";
$code = 200;
}
# is it an object and show_method is defined?.
elsif ( $ref =~ qr(::) && blessed( $self->$attr )
&& $show )
{
$txt .= "$attr: ".$self->$attr->$show."\n";
$code = 200;
}
# is it an object with dump? Probably OIO.
elsif ( $ref =~ qr(::) && blessed($self->$attr)
&& $self->$attr->can( 'dump') )
{
$var = $self->$attr->dump(0);
$txt .= Dump($var)."\n";
$code = 200;
}
elsif ( $ref =~ qr(HASH) )
{
foreach my $key ( sort keys %{$self->$attr} )
{
my $subref = ref($self->$attr->{ $key } );
$self->Verbose("show key($key) subref($subref)",0);
# simple scalar
if ( not $subref )
{
$txt .= "$attr ->{ $key }: ".$self->$attr->{$key}." \n";
$code = 200;
}
# is it an object and show_method is defined?.
elsif ( $subref =~ qr(::) &&
blessed($self->$attr->{ $key }) &&
defined($show) )
{
$txt .= "$attr: ".$self->$attr->{$key}->$show."\n";
$code = 200;
}
# is it an object with dump? Probably OIO.
elsif ( $subref =~ qr(::) &&
blessed($self->$attr->{ $key }) &&
$self->$attr->{ $key }->can( 'dump') )
{
$var = $self->$attr->{$key}->dump(0);
$txt .= Dump($var)."\n";
$code = 200;
}
# some other object, array or hash
else
{
$var = $self->$attr->{$key};
$txt .= Dump($var)."\n";
$code = 200;
}
}
}
elsif ( $ref =~ qr(ARRAY) )
{
my $i = 0;
foreach my $val ( @{$self->$attr} )
{
my $subref = ref( $val );
# simple scalar
if ( not $subref )
{
$txt .= "$attr ->[ $i ]: ".$val." \n";
$code = 200;
}
# is it an object and show_method is defined?.
elsif ( $subref =~ qr(::) &&
blessed($val) &&
defined($show) )
{
$txt .= "$attr: ".$val->$show."\n";
$code = 200;
}
# is it an object with dump? Probably OIO.
elsif ( $subref =~ qr(::) &&
blessed($val) &&
$val->can( 'dump') )
{
$var = $val->dump(0);
$txt .= Dump($var)."\n";
$code = 200;
}
# some other object, array or hash
else
{
$txt .= Dump($val)."\n";
$code = 200;
}
}
}
# some other object
else
{
$var = $self->$attr;
$txt .= Dump($var)."\n";
$code = 200;
}
}
elsif ( $self->can( $attr ) )
{
$txt = $what.": #!undefined";
$code = 200;
}
else # should get here, but might if parameter error.
{
$txt = $what.": #!ERROR does not exist";
$code = 404;
}
}
}
# if we didn't find anything at all, then a 404 is returned
if (!defined($txt) || $txt eq '' )
{
$txt = $what.": #!ERROR not found";
$code = 404;
}
$request->Respond($kernel, $txt, $code);
}
=item settings
This POE event handler executes the set commands.
=cut
sub settings { # Can't call it set
my ($kernel, $self, $sender, $request, ) =
@_[KERNEL, OBJECT, SENDER, ARG0, ];
my $txt = '';
my ($param, $code);
my $command = $request->command->[0];
# called directly because $command may be an alias and not the real name
my $cmd = $self->commands->{'set'};
lib/Agent/TCLI/Package/Base.pm view on Meta::CPAN
'do_verbose' => $self->do_verbose,
$args,
);
# $parameters[$$self]{ $name }->verbose($self->verbose);
# $parameters[$$self]{ $name }->do_verbose($self->do_verbose);
# Create field if there isn't a field in the package for this parameter
if (! $self->can($name) )
{
my $arg;
if (exists($args->{'default'}))
{
$arg = ":Arg('name'=>'$name', 'default'=> '$args->{'default'}') ";
}
else
{
$arg = ":Arg('name'=>'$name') ";
}
my $type = exists($args->{'class'})
? ":Type('".$args->{'class'}."') "
: '';
$class->create_field('@'.$name, ":Acc($name) ".$arg.$type);
# Add in defaut value, since if we're after preinit, it won't
# be there.
$self->$name($args->{'default'}) if (exists($args->{'default'}));
}
return 1;
}
sub AddCommand {
my ($self, $object, $args) = @_;
my $name = $args->{'name'};
if ( !defined($name ) )
{
$self->Verbose("AddCommand: No name!",0);
return;
}
$self->Verbose("AddCommand: adding $name ");
$self->Verbose("AddCommand: adding $name args dump ",3,$args);
$commands[$$self]{ $name } = $object->new(
'verbose' => $self->verbose,
'do_verbose' => $self->do_verbose,
$args,
);
$self->Verbose("AddCommand: adding $name command dump ".$commands[$$self]{ $name }->dump(1),3);
# Parameters were just stubs. Put in proper references.
if ( defined( $commands[$$self]{ $name }->parameters ) )
{
foreach my $paramkey ( keys %{ $commands[$$self]{ $name }->parameters } )
{
if ( exists( $parameters[$$self]->{ $paramkey } ) &&
blessed($parameters[$$self]->{ $paramkey }) =~ qr(Parameter) )
{
$commands[$$self]{ $name }->parameters->{ $paramkey } =
$parameters[$$self]->{ $paramkey };
}
else # All this is just for helping to debug problems easier
{
$self->Verbose("AssCommand: $name Parameter '$paramkey' not defined. Dumping",0 );
foreach my $parameter ( %{$parameters[$$self]} )
{
if ( blessed($parameter) )
{
$self->Verbose( $parameter->dump(1),0 );
}
else
{
$self->Verbose( $parameter,0 );
}
}
croak("AddCommand: $name Parameter '$paramkey' not defined")
}
}
}
return 1;
}
sub AddCommands {
my ($self, @cmds) = @_;
# Hmmm perhaps some validation should ocurr in the future?
foreach my $cmd (@cmds)
{
$commands[$$self]{ $cmd->name } = $cmd;
}
return 1;
}
sub YamlPrint {
my ($self, $ref ) = @_;
return Dump($ref);
}
1;
=back
=head1 AUTHOR
Eric Hacker E<lt>hacker at cpan.orgE<gt>
=head1 BUGS
SHOULDS and MUSTS are currently not enforced.
Test scripts not thorough enough.
Probably many others.
=head1 LICENSE
Copyright (c) 2007, Alcatel Lucent, All rights resevred.
This package is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.
=cut
( run in 1.911 second using v1.01-cache-2.11-cpan-39bf76dae61 )