Agent-TCLI

 view release on metacpan or  search on metacpan

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

							$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'};

	# TODO a way to unset/restore defaults....

	# break down and validate args
	return unless ($param = $cmd->Validate($kernel, $request) );

	$self->Verbose("set: param dump",1,$param);

	# Get meta data
	my $meth = $self->meta->get_methods();

	foreach my $attr ( keys %{$param} )
	{
		# param will have all fields defined, gotta skip the empty ones.
		# Can't use ne due to NetAddr::IP bug
		next unless (defined($param->{$attr})
#			&& !($param->{$attr} eq '')  # diabled, since we should be OK now.
			);

		$self->Verbose("settings: setting attr($attr) => ".
			$param->{$attr}." ");

		# is there a field type object for this attr?
		if ( ref($param->{$attr}) eq '' &&
			exists( $meth->{$attr} ) &&



( run in 2.222 seconds using v1.01-cache-2.11-cpan-d80b1682f3f )