view release on metacpan or  search on metacpan

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

=cut
my @controls		:Field;

=item requests

A hash collection of requests that are in progress

=cut
my @requests		:Field
					:Type('HASH')
					:Arg('name' => 'requests', 'default' => { } )
					:Acc('requests');

=item wheels

A hash of wheels keyed on wheel ID.
B<wheels> values should only be POE::Wheels.

=cut
my @wheels			:Field;



# Standard class utils are inherited

=back

=head2 METHODS

Most of these methods are for internal use within the TCLI system and may
be of interest only to developers trying to enhance TCLI.

=over

=cut

sub _preinit :Preinit {
	my ($self,$args) = @_;

  	$args->{'session'} = POE::Session->create(
		object_states => [
          	$self => [qw(
          		_start
          		_stop
          		_shutdown
          		_default

				establish_context
				settings
				show
				)],
      		],
		)
	 unless defined( $args->{'session'} );
}

# This POE event handler is called when POE starts up a Package.
# The B<_start> method is :Cumulative within OIO. Ideally, most command packages
# could use this Base _start method without implementing
# their own. However there seems to be a race condition between the POE
# initialization and the OIO object initialization. Until this is debugged
# one will probably have to have this _start method in every package.

sub _start :Cumulative {
	my ($kernel,  $self,  $session) =
      @_[KERNEL, OBJECT,   SESSION];

	# are we up before OIO has finished initializing object?
	if (!defined( $self->name ))
	{
		$self->Verbose("_start: OIO not done re-starting");
		$kernel->yield('_start');
#		$kernel->delay('_start', 1 );
		return;
	}
	$self->Verbose("_start: ".$self->name()." starting");
	# There is only one command object per TCLI
    $kernel->alias_set($self->name);
}

# This POE event handler is used to initiate a shutdown of the Control.

sub _shutdown :Cumulative {
	my ($kernel,  $self,) =
      @_[KERNEL, OBJECT,];
	$self->Verbose("_shutdown:base ".$self->name." shutting down");

	$self->Verbose("shutdown:base deleting wheels ",2);
    foreach my $wheel ( keys %{ $wheels[$$self] } )
    {
    	$self->SetWheel($wheel);
    }
    foreach my $control ( keys %{ $controls[$$self] } )
    {
    	$self->SetControl($control);
    }
    # clear all alarms you might have set
    $kernel->alarm_remove_all();

    return ("_shutdown:base ".$self->name )
}

#This POE event handler is called when POE stops a Package.
#The B<_stop> method is :Cumulative within OIO.

sub _stop :Cumulative {
    my ($kernel,  $self,) =
      @_[KERNEL, OBJECT,];

	$self->Verbose("_stop: ".$self->name." stopping");

	return($self->name.":_stop complete ");
}

#Just a placeholder that does nothing but collect unhandled child events
#to keep them out of default.

sub _child {
  my ($kernel,  $self, $session, $id, $error) =
    @_[KERNEL, OBJECT,  SESSION, ARG1, ARG2 ];

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

#    $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.