view release on metacpan or  search on metacpan

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

							$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} ) &&
			exists( $meth->{$attr}{'type'} ) &&
			$meth->{$attr}{'type'} =~ /::/ )
		{
			my $class = $meth->{$attr}{'type'};
			$self->Verbose("set: class($class) param($param) attr($attr) ");
			my $obj;
			eval {
				no strict 'refs';
				$obj = $class->new($param->{$attr});
			};
			# If it went bad, error and return nothing.
			if( $@ )
			{
				$@ =~ qr(Usage:\s(.*)$)m ;
				$txt = $1;
				$self->Verbose('set: new '.$class.' got ('.$txt.') ');
				$request->Respond($kernel,  "Invalid: $attr !", 400);
				return;
			}
			eval { $self->$attr($obj) };
			if( $@ )
			{
				$@ =~ qr(Usage:\s(.*)$)m ;
				$txt = $1;
				$self->Verbose('set: new '.$class.' got ('.$txt.') ');
				$request->Respond($kernel,  "Invalid: $attr !", 400);
				return;
			}
			$txt .= "Set ".$attr." to ".$param->{$attr}." \n";
			$code = 200;

		}
		else
		{
			eval { $self->$attr( $param->{$attr} ) };
			if( $@ )
			{
				$@ =~ qr(Usage:\s(.*)$)m ;
				$txt = $1;