722 lines
22 KiB
Perl
722 lines
22 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
|
||
|
|
package JMX::Jmx4Perl::J4psh::Command::MBean;
|
||
|
|
use strict;
|
||
|
|
use base qw(JMX::Jmx4Perl::J4psh::Command);
|
||
|
|
use JMX::Jmx4Perl::Util;
|
||
|
|
use JMX::Jmx4Perl::Request;
|
||
|
|
use Data::Dumper;
|
||
|
|
use JSON;
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
JMX::Jmx4Perl::J4psh::Command::MBean - MBean commands
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
=head1 COMMANDS
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
|
||
|
|
# Name of this command
|
||
|
|
sub name { "mbean" }
|
||
|
|
|
||
|
|
# We hook into as top-level commands
|
||
|
|
sub top_commands {
|
||
|
|
my $self = shift;
|
||
|
|
return $self->agent ? $self->domain_commands : {};
|
||
|
|
}
|
||
|
|
|
||
|
|
# The 'real' commands
|
||
|
|
sub domain_commands {
|
||
|
|
my $self = shift;
|
||
|
|
return {
|
||
|
|
"ls" => {
|
||
|
|
desc => "List MBean Domains",
|
||
|
|
proc => $self->cmd_list_domains,
|
||
|
|
args => $self->complete->mbeans(all => 1),
|
||
|
|
},
|
||
|
|
"cd" => {
|
||
|
|
desc => "Enter a domain",
|
||
|
|
proc => sub {
|
||
|
|
my $domain = join '',@_;
|
||
|
|
$self->_cd_absolute($domain);
|
||
|
|
},
|
||
|
|
args => $self->complete->mbeans(all => 1),
|
||
|
|
},
|
||
|
|
};
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
sub property_commands {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
my $prop_cmds = $self->mbean_commands;
|
||
|
|
return {
|
||
|
|
"ls" => {
|
||
|
|
desc => "List MBeans for a domain",
|
||
|
|
proc => $self->cmd_list_domains($domain),
|
||
|
|
args => $self->complete->mbeans(domain => $domain),
|
||
|
|
},
|
||
|
|
"cd" => {
|
||
|
|
desc => "Enter a MBean",
|
||
|
|
proc => sub {
|
||
|
|
#print Dumper([@_]);
|
||
|
|
#print Devel::StackTrace->new->as_string;
|
||
|
|
my $input = join '',@_;
|
||
|
|
if (!$self->_handle_navigation($input)) {
|
||
|
|
if ($input =~ /:/) {
|
||
|
|
$self->_cd_absolute($input);
|
||
|
|
} else {
|
||
|
|
$self->_cd_mbean($domain,$input);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
},
|
||
|
|
args => $self->complete->mbeans(domain => $domain)
|
||
|
|
},
|
||
|
|
"pwd" => {
|
||
|
|
desc => "Print currently selected domain",
|
||
|
|
proc => sub {
|
||
|
|
my ($s,$r) = $self->color("domain_name","reset");
|
||
|
|
print $s . $domain . $r,":\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub mbean_commands {
|
||
|
|
my $self = shift;
|
||
|
|
my $mbean_props = shift;
|
||
|
|
return {
|
||
|
|
"ls" => {
|
||
|
|
desc => "List MBeans for a domain.",
|
||
|
|
doc => <<EOT,
|
||
|
|
List all MBeans within a domain.
|
||
|
|
|
||
|
|
The following options are supported:
|
||
|
|
|
||
|
|
-a: Attributes only
|
||
|
|
-o: Operations only
|
||
|
|
|
||
|
|
Wildcards are supported for filtering
|
||
|
|
EOT
|
||
|
|
proc => $self->cmd_show_mbean($mbean_props),
|
||
|
|
#args => $self->complete->mbean_attribs($mbean_props),
|
||
|
|
},
|
||
|
|
"cd" => {
|
||
|
|
desc => "Navigate up (..), to the top (/) or directly to another MBean",
|
||
|
|
proc => sub {
|
||
|
|
my $input = join '',@_;
|
||
|
|
if (!$self->_handle_navigation($input)) {
|
||
|
|
if ($input =~ /:/) {
|
||
|
|
# "Absolute path"
|
||
|
|
$self->_cd_absolute($input);
|
||
|
|
} else {
|
||
|
|
die "No MBean '",$input,"' known\n";
|
||
|
|
}
|
||
|
|
};
|
||
|
|
},
|
||
|
|
},
|
||
|
|
"cat" => {
|
||
|
|
desc => "Show value of an attribute",
|
||
|
|
proc => $self->cmd_show_attributes($mbean_props),
|
||
|
|
args => $self->complete->mbean_attributes($mbean_props),
|
||
|
|
},
|
||
|
|
"set" => {
|
||
|
|
desc => "Set value of an attribute",
|
||
|
|
proc => $self->cmd_set_attribute($mbean_props),
|
||
|
|
args => $self->complete->mbean_attributes($mbean_props),
|
||
|
|
},
|
||
|
|
|
||
|
|
"exec" => {
|
||
|
|
desc => "Execute an operation",
|
||
|
|
proc => $self->cmd_execute_operation($mbean_props),
|
||
|
|
args => $self->complete->mbean_operations($mbean_props),
|
||
|
|
},
|
||
|
|
"pwd" => {
|
||
|
|
desc => "Show the currently selected MBean",
|
||
|
|
proc => sub {
|
||
|
|
my ($d,$k,$v,$r) = $self->color("domain_name","property_key","property_value","reset");
|
||
|
|
print $d . $mbean_props->{domain} . $r . ":" . $self->_color_props($mbean_props) . "\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cmd_show_attributes {
|
||
|
|
my $self = shift;
|
||
|
|
my $m_info = shift;
|
||
|
|
return sub {
|
||
|
|
my $attributes = @_;
|
||
|
|
my $info = $m_info->{info};
|
||
|
|
my $mbean = $m_info->{full};
|
||
|
|
my $context = $self->context;
|
||
|
|
my $agent = $context->agent;
|
||
|
|
my @attrs = ();
|
||
|
|
for my $a (@_) {
|
||
|
|
if ($a =~ /[\*\?]/) {
|
||
|
|
my $regexp = $self->convert_wildcard_pattern_to_regexp($a);
|
||
|
|
push @attrs, grep { $_ =~ /^$regexp$/ } keys %{$m_info->{info}->{attr}};
|
||
|
|
} else {
|
||
|
|
push @attrs,$a;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# Use only unique values
|
||
|
|
my %attrM = map { $_ => 1 } @attrs;
|
||
|
|
@attrs = keys %attrM;
|
||
|
|
if (@attrs == 0) {
|
||
|
|
die "No attribute given\n";
|
||
|
|
}
|
||
|
|
my $request = JMX::Jmx4Perl::Request->new(READ,$mbean,\@attrs,{ignoreErrors => 1});
|
||
|
|
my $response = $agent->request($request);
|
||
|
|
if ($response->is_error) {
|
||
|
|
die "Error: " . $response->error_text;
|
||
|
|
}
|
||
|
|
my $values = $response->value;
|
||
|
|
my $p = "";
|
||
|
|
my ($c_a,$c_r) = $self->color("attribute_name","reset");
|
||
|
|
if (@attrs > 1) {
|
||
|
|
# Print as list
|
||
|
|
for my $attr (@attrs) {
|
||
|
|
my $value = $values->{$attr};
|
||
|
|
if ($self->_is_object($value)) {
|
||
|
|
$p .= sprintf(" $c_a%-31.31s$c_r\n",$attr);
|
||
|
|
$p .= $self->_dump($value);
|
||
|
|
} else {
|
||
|
|
$p .= sprintf(" $c_a%-31.31s$c_r %s\n",$attr,$self->_dump_scalar($value));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# Print single attribute
|
||
|
|
my $value = $values->{$attrs[0]};
|
||
|
|
if ($self->_is_object($value)) {
|
||
|
|
$p .= $self->_dump($value);
|
||
|
|
} else {
|
||
|
|
$p .= $self->_dump_scalar($value)."\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$self->print_paged($p);
|
||
|
|
};
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cmd_set_attribute {
|
||
|
|
my $self = shift;
|
||
|
|
my $m_info = shift;
|
||
|
|
return sub {
|
||
|
|
my @args = @_;
|
||
|
|
die "Usage: set <attribute-name> <value> [<path>]\n" if (@args != 2 && @args != 3);
|
||
|
|
my $mbean = $m_info->{full};
|
||
|
|
my $agent = $self->context->agent;
|
||
|
|
my $req = new JMX::Jmx4Perl::Request(WRITE,$mbean,$args[0],$args[1],$args[2]);
|
||
|
|
my $resp = $agent->request($req);
|
||
|
|
if ($resp->is_error) {
|
||
|
|
die $resp->error_text . "\n";
|
||
|
|
}
|
||
|
|
my $old_value = $resp->value;
|
||
|
|
my ($c_l,$c_r) = $self->color("label","reset");
|
||
|
|
|
||
|
|
my $p = "";
|
||
|
|
if ($self->_is_object($old_value)) {
|
||
|
|
$p .= sprintf(" $c_l%-5.5ss$c_r\n","Old:");
|
||
|
|
$p .= $self->_dump($old_value);
|
||
|
|
} else {
|
||
|
|
$p .= sprintf(" $c_l%-5.5s$c_r %s\n","Old:",$self->_dump_scalar($old_value));
|
||
|
|
}
|
||
|
|
$p .= sprintf(" $c_l%-5.5s$c_r %s\n","New:",$args[1]);;
|
||
|
|
$self->print_paged($p);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cmd_execute_operation {
|
||
|
|
my $self = shift;
|
||
|
|
my $m_info = shift;
|
||
|
|
return sub {
|
||
|
|
my @args = @_;
|
||
|
|
die "Usage: exec <attribute-name> <value> [<path>]\n" if (!@args);
|
||
|
|
my $mbean = $m_info->{full};
|
||
|
|
my $agent = $self->context->agent;
|
||
|
|
my $req = new JMX::Jmx4Perl::Request(EXEC,$mbean,@args,{ignoreErrors => 1});
|
||
|
|
my $resp = $agent->request($req);
|
||
|
|
if ($resp->is_error) {
|
||
|
|
die $resp->error_text . "\n";
|
||
|
|
}
|
||
|
|
my $value = $resp->value;
|
||
|
|
my ($c_l,$c_r) = $self->color("label","reset");
|
||
|
|
|
||
|
|
my $p = "";
|
||
|
|
if ($self->_is_object($value)) {
|
||
|
|
$p .= sprintf(" $c_l%-7.7s$c_r\n","Return:");
|
||
|
|
$p .= $self->_dump($value);
|
||
|
|
} else {
|
||
|
|
$p .= sprintf(" $c_l%-7.7s$c_r %s\n","Return:",$self->_dump_scalar($value));
|
||
|
|
}
|
||
|
|
$self->print_paged($p);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _is_object {
|
||
|
|
my $self = shift;
|
||
|
|
my $value = shift;
|
||
|
|
return JMX::Jmx4Perl::Util->is_object_to_dump($value);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _dump {
|
||
|
|
my $self = shift;
|
||
|
|
my $value = shift;
|
||
|
|
return JMX::Jmx4Perl::Util->dump_value($value,{format => $self->_get_opt_or_config("format"),
|
||
|
|
booleans => $self->_get_opt_or_config("booleans"),
|
||
|
|
indent => $self->_get_opt_or_config("indent")});
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _dump_scalar {
|
||
|
|
my $self = shift;
|
||
|
|
return JMX::Jmx4Perl::Util->dump_scalar(shift,$self->_get_opt_or_config("booleans"));
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
sub _get_opt_or_config {
|
||
|
|
my $self = shift;
|
||
|
|
my $key = shift;
|
||
|
|
|
||
|
|
my $args = $self->context->args || {};
|
||
|
|
my $config = $self->context->config || {};
|
||
|
|
if (defined($args->{option}) && defined($args->{option}->{lc $key})) {
|
||
|
|
return $args->{option}->{lc $key};
|
||
|
|
} else {
|
||
|
|
my $shell_config = $config->{shell} || {};
|
||
|
|
return $shell_config->{lc $key};
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# ===================================================================================================
|
||
|
|
|
||
|
|
=item cmd_list
|
||
|
|
|
||
|
|
List commands which can filter mbean by wildcard and knows about the
|
||
|
|
following options:
|
||
|
|
|
||
|
|
=over
|
||
|
|
|
||
|
|
=item -l
|
||
|
|
|
||
|
|
Show attributes and operations
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
If a single mbean is given as argument its details are shown.
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub cmd_list_domains {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
return sub {
|
||
|
|
my $context = $self->context;
|
||
|
|
my $agent = $context->agent;
|
||
|
|
print "Not connected to a server\n" and return unless $agent;
|
||
|
|
my ($opts,@filters) = $self->extract_command_options(["l!"],@_);
|
||
|
|
if ($domain) {
|
||
|
|
if (@filters) {
|
||
|
|
@filters = map { $domain . ":" .$_ } @filters
|
||
|
|
} else {
|
||
|
|
@filters = "$domain:*";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# Show all
|
||
|
|
if (@filters) {
|
||
|
|
for my $filter (@filters) {
|
||
|
|
my $regexp = $self->convert_wildcard_pattern_to_regexp($filter);
|
||
|
|
my $mbean_filter;
|
||
|
|
($filter,$mbean_filter) = ($1,$2) if ($filter && $filter =~ /(.*?):(.*)/) ;
|
||
|
|
# It's a domain (pattern)
|
||
|
|
$self->show_domain($opts,$self->_filter($context->mbeans_by_domain,$filter),$mbean_filter);
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$self->show_domain($opts,$self->_filter($context->mbeans_by_domain));
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub cmd_show_mbean {
|
||
|
|
my $self = shift;
|
||
|
|
my $m_info = shift;
|
||
|
|
return sub {
|
||
|
|
my $info = $m_info->{info};
|
||
|
|
my ($c_m,$c_a,$c_o,$c_r) = $self->color("mbean_name","attribute_name","operation_name","reset");
|
||
|
|
my $op_len = 50 + length($c_o) + length($c_r);
|
||
|
|
my ($do_show_attrs,$do_show_ops,$filters) = $self->_show_what_from_mbean($info,@_);
|
||
|
|
|
||
|
|
my $p = "";
|
||
|
|
|
||
|
|
my $name = $m_info->{full};
|
||
|
|
$p .= $c_m . $name . $c_r;
|
||
|
|
$p .= "\n\n";
|
||
|
|
|
||
|
|
#print Dumper($m_info);
|
||
|
|
my $attrs = $info->{attr};
|
||
|
|
if ($do_show_attrs) {
|
||
|
|
my @lines = ();
|
||
|
|
for my $attr (keys %$attrs) {
|
||
|
|
my $line = "";
|
||
|
|
if ($self->_pass_filter($attr,$filters)) {
|
||
|
|
if (length($attr) > 31) {
|
||
|
|
$line .= sprintf(" $c_a%s$c_r\n",$attr);
|
||
|
|
$line .= sprintf(" %-31.31s %-13.13s %-4.4s %s\n",
|
||
|
|
$self->_pretty_print_type($attrs->{$attr}->{type}),
|
||
|
|
$attrs->{$attr}->{rw} eq "false" ? "[ro]" : "",$attrs->{$attr}->{desc});
|
||
|
|
} else {
|
||
|
|
$line .= sprintf(" $c_a%-31.31s$c_r %-13.13s %-4.4s %s\n",$attr,
|
||
|
|
$self->_pretty_print_type($attrs->{$attr}->{type}),
|
||
|
|
$attrs->{$attr}->{rw} eq "false" ? "[ro]" : "",$attrs->{$attr}->{desc});
|
||
|
|
}
|
||
|
|
push @lines,$line;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if (@lines) {
|
||
|
|
$p .= "Attributes:\n";
|
||
|
|
$p .= join "",@lines;
|
||
|
|
$p .= "\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
my $ops = $info->{op};
|
||
|
|
if ($do_show_ops) {
|
||
|
|
my @lines = ();
|
||
|
|
for my $op (keys %$ops) {
|
||
|
|
my $line = "";
|
||
|
|
if ($self->_pass_filter($op,$filters)) {
|
||
|
|
my $overloaded = ref($ops->{$op}) eq "ARRAY" ? $ops->{$op} : [ $ops->{$op} ];
|
||
|
|
for my $m_info (@$overloaded) {
|
||
|
|
my $sig = $self->_signature_to_print($op,$m_info);
|
||
|
|
if (length($sig) > $op_len) {
|
||
|
|
$line .= sprintf(" %s\n",$sig);
|
||
|
|
$line .= sprintf(" %-50.50s %s\n","",$m_info->{desc}) if $m_info->{desc};
|
||
|
|
} else {
|
||
|
|
$line .= sprintf(" %-${op_len}.${op_len}s %s\n",$sig,$m_info->{desc});
|
||
|
|
}
|
||
|
|
}
|
||
|
|
push @lines,$line;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if (@lines) {
|
||
|
|
$p .= "Operations:\n";
|
||
|
|
$p .= join "",@lines;
|
||
|
|
$p .= "\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$self->print_paged($p);
|
||
|
|
#print Dumper($info);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _pass_filter {
|
||
|
|
my $self = shift;
|
||
|
|
my $check = shift;
|
||
|
|
my $regexps = shift;
|
||
|
|
return 1 unless @$regexps;
|
||
|
|
for my $regexp (@$regexps) {
|
||
|
|
return 1 if $check =~ $regexp;
|
||
|
|
}
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _show_what_from_mbean {
|
||
|
|
my $self = shift;
|
||
|
|
my ($info,@args) = @_;
|
||
|
|
my ($opts,@filter) = $self->extract_command_options(["attributes|a!","operations|ops|o!"],@args);
|
||
|
|
my $no_restrict = !defined($opts->{attributes}) && !defined($opts->{operations});
|
||
|
|
my $show_attrs = $info->{attr} && keys %{$info->{attr}} && ($opts->{attributes} || $no_restrict);
|
||
|
|
my $show_ops = $info->{op} && keys %{$info->{op}} && ($opts->{operations} || $no_restrict);
|
||
|
|
my @filter_regexp = map {
|
||
|
|
s/\*/.*/g;
|
||
|
|
s/\?/./g;
|
||
|
|
my $f = '^' . $_ . '$';
|
||
|
|
qr/$f/i
|
||
|
|
} @filter;
|
||
|
|
return ($show_attrs,$show_ops,\@filter_regexp);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _line_aligned {
|
||
|
|
my $self = shift;
|
||
|
|
my $max_lengths = shift;
|
||
|
|
my $lengths = shift;
|
||
|
|
my $parts = shift;
|
||
|
|
my $opts = shift;
|
||
|
|
|
||
|
|
my $term_width = $self->context->term_width;
|
||
|
|
my $overflow = $opts->{overflow_col} || 0;
|
||
|
|
my $wrap_last = $opts->{wrap};
|
||
|
|
my $ret = "";
|
||
|
|
for my $i (0 .. $overflow) {
|
||
|
|
if ($lengths->[$i] > $max_lengths->[$i]) {
|
||
|
|
|
||
|
|
# Do overflow
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _signature_to_print {
|
||
|
|
my $self = shift;
|
||
|
|
my $op = shift;
|
||
|
|
my $info = shift;
|
||
|
|
my ($c_o,$c_r) = $self->color("operation_name","reset");
|
||
|
|
# print Dumper($info);
|
||
|
|
my $ret = $self->_pretty_print_type($info->{ret}) . " ";
|
||
|
|
$ret .= $c_o . $op . $c_r;
|
||
|
|
$ret .= "(";
|
||
|
|
my $args = $info->{args};
|
||
|
|
my @arg_cl = ();
|
||
|
|
for my $a (@$args) {
|
||
|
|
if (ref($a) eq "HASH") {
|
||
|
|
push @arg_cl,$self->_pretty_print_type($a->{type})
|
||
|
|
} else {
|
||
|
|
push @arg_cl,$self->_pretty_print_type($a);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$ret .= join ",",@arg_cl;
|
||
|
|
$ret .= ")";
|
||
|
|
return $ret;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _pretty_print_type {
|
||
|
|
my $self = shift;
|
||
|
|
my $type = shift;
|
||
|
|
my $suffix = "";
|
||
|
|
my $type_p;
|
||
|
|
if ($type eq "[J") {
|
||
|
|
return "long[]";
|
||
|
|
} elsif ($type =~ /^\[L(.*);/) {
|
||
|
|
$type_p = $1;
|
||
|
|
$suffix = "[]";
|
||
|
|
} else {
|
||
|
|
$type_p = $type;
|
||
|
|
}
|
||
|
|
$type_p =~ s/^.*\.([^\.]+)$/$1/;
|
||
|
|
return $type_p . $suffix;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub show_mbeans {
|
||
|
|
my $self = shift;
|
||
|
|
my $opts = shift;
|
||
|
|
my $infos = shift;
|
||
|
|
my $mbean_filter;
|
||
|
|
my $l = "";
|
||
|
|
for my $m_info (sort { $a->{string} cmp $b->{string} } values %$infos) {
|
||
|
|
my ($c_d,$c_s,$c_r) = $self->color("domain_name","stat_val","reset");
|
||
|
|
$l .= $c_d . $m_info->{domain} . $c_r . ":";
|
||
|
|
$l .= $self->_color_props($m_info) . "\n";
|
||
|
|
}
|
||
|
|
$self->print_paged($l);
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
sub show_domain {
|
||
|
|
my $self = shift;
|
||
|
|
my $opts = shift;
|
||
|
|
my $infos = shift;
|
||
|
|
|
||
|
|
my $mbean_filter = shift;
|
||
|
|
$mbean_filter = $self->convert_wildcard_pattern_to_regexp($mbean_filter) if $mbean_filter;
|
||
|
|
my $text = "";
|
||
|
|
for my $domain (keys %$infos) {
|
||
|
|
my ($c_d,$c_reset) = $self->color("domain_name","reset");
|
||
|
|
$text .= $c_d . "$domain:" . $c_reset . "\n";
|
||
|
|
for my $m_info (sort { $a->{string} cmp $b->{string} } @{$infos->{$domain}}) {
|
||
|
|
next if ($mbean_filter && $m_info->{string} !~ $mbean_filter);
|
||
|
|
$text .= " ".$self->_color_props($m_info)."\n";
|
||
|
|
$text .= $self->_list_details(" ",$m_info) if $opts->{l};
|
||
|
|
}
|
||
|
|
$text .= "\n";
|
||
|
|
}
|
||
|
|
$self->print_paged($text);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _list_details {
|
||
|
|
my $self = shift;
|
||
|
|
my $indent = shift;
|
||
|
|
my $m_info = shift;
|
||
|
|
my ($c_s,$c_r) = $self->color("stat_val","reset");
|
||
|
|
|
||
|
|
my $line = "";
|
||
|
|
if ($m_info->{info}->{desc}) {
|
||
|
|
$line .= $m_info->{info}->{desc};
|
||
|
|
}
|
||
|
|
my $nr_attr = scalar(keys %{$m_info->{info}->{attr}});
|
||
|
|
my $nr_op = scalar(keys %{$m_info->{info}->{op}});
|
||
|
|
my $nr_notif = scalar(keys %{$m_info->{info}->{notif}});
|
||
|
|
if ($nr_attr || $nr_op || $nr_notif) {
|
||
|
|
my @f;
|
||
|
|
push @f,"Attributes: " . $c_s . $nr_attr . $c_r if $nr_attr;
|
||
|
|
push @f,"Operations: " . $c_s . $nr_op . $c_r if $nr_op;
|
||
|
|
push @f,"Notifications: " . $c_s . $nr_notif . $c_r if $nr_notif;
|
||
|
|
$line .= $indent . join(", ",@f) . "\n";
|
||
|
|
}
|
||
|
|
return $line;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _color_props {
|
||
|
|
my $self = shift;
|
||
|
|
my $info = shift;
|
||
|
|
my ($c_k,$c_v,$c_r) = $self->color("property_key","property_value","reset");
|
||
|
|
#return Dumper($info);
|
||
|
|
return join ",",map { $c_k . $_ . $c_r . "=" . $c_v . $info->{props}->{$_} . $c_r } sort keys %{$info->{props}};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _filter {
|
||
|
|
my $self = shift;
|
||
|
|
my $map = shift;
|
||
|
|
my @filters = @_;
|
||
|
|
my @keys = keys %{$map};
|
||
|
|
|
||
|
|
if (@filters) {
|
||
|
|
my %filtered;
|
||
|
|
for my $f (@filters) {
|
||
|
|
my $regexp = $self->convert_wildcard_pattern_to_regexp($f);
|
||
|
|
for my $d (@keys) {
|
||
|
|
$filtered{$d} = $map->{$d} if $d =~ $regexp;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return \%filtered;
|
||
|
|
} else {
|
||
|
|
return $map;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
sub _cd_absolute {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
my $props;
|
||
|
|
|
||
|
|
if ($domain) {
|
||
|
|
$domain =~ s/:+$//;
|
||
|
|
($domain,$props) = split(/:/,$domain,2) if $domain =~ /:/;
|
||
|
|
}
|
||
|
|
die "No domain $domain\n" unless $self->_check_domain($domain);
|
||
|
|
$self->_check_mbean($domain,$props) if $props;
|
||
|
|
$self->reset_stack;
|
||
|
|
$self->_cd_domain($domain);
|
||
|
|
$self->_cd_mbean($domain,$props) if $props;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _check_mbean {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
my $props = shift;
|
||
|
|
$self->_get_mbean($domain,$props) || die "No MBean $domain:$props\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _cd_domain {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
die "No domain $domain\n" unless $self->_check_domain($domain);
|
||
|
|
my $prop_cmds = $self->property_commands($domain);
|
||
|
|
&{$self->push_on_stack($domain,$prop_cmds,":")};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _cd_mbean {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
my $mbean = shift;
|
||
|
|
|
||
|
|
my $mbean_props = $self->_check_mbean($domain,$mbean);
|
||
|
|
my $mbean_cmds = $self->mbean_commands($mbean_props);
|
||
|
|
&{$self->push_on_stack($mbean_props->{prompt},$mbean_cmds)};
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _check_domain {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
my $context = $self->context;
|
||
|
|
return exists($context->mbeans_by_domain->{$domain});
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _get_mbean {
|
||
|
|
my $self = shift;
|
||
|
|
my $domain = shift;
|
||
|
|
my $props = shift;
|
||
|
|
my $context = $self->context;
|
||
|
|
if ($props =~ /\*/) {
|
||
|
|
my $mbeans = $context->search_mbeans($domain . ":" . $props);
|
||
|
|
# TODO: If more than one, present a menu to select from. Now simply die
|
||
|
|
return undef unless @{$mbeans};
|
||
|
|
if (scalar(@$mbeans) > 1) {
|
||
|
|
my $toomany = "";
|
||
|
|
for my $m (@$mbeans) {
|
||
|
|
my ($s,$r) = $self->color("mbean_name","reset");
|
||
|
|
$toomany .=" >>> " . $s . $m->{full} . $r . "\n";
|
||
|
|
}
|
||
|
|
die "More than one MBean found:\n" . $toomany;
|
||
|
|
}
|
||
|
|
return $mbeans->[0];
|
||
|
|
}
|
||
|
|
return $context->mbeans_by_name->{$domain . ":" . $props};
|
||
|
|
}
|
||
|
|
|
||
|
|
# Handle navigational commands
|
||
|
|
sub _handle_navigation {
|
||
|
|
my $self = shift;
|
||
|
|
my $input = shift;
|
||
|
|
if ($input eq "..") {
|
||
|
|
$self->pop_off_stack;
|
||
|
|
return 1;
|
||
|
|
} elsif ($input eq "/" || !$input) {
|
||
|
|
$self->reset_stack;
|
||
|
|
return 1;
|
||
|
|
} else {
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _filter_domains {
|
||
|
|
|
||
|
|
};
|
||
|
|
|
||
|
|
|
||
|
|
=head1 LICENSE
|
||
|
|
|
||
|
|
This file is part of osgish.
|
||
|
|
|
||
|
|
Osgish is free software: you can redistribute it and/or modify
|
||
|
|
it under the terms of the GNU General Public License as published by
|
||
|
|
the Free Software Foundation, either version 2 of the License, or
|
||
|
|
(at your option) any later version.
|
||
|
|
|
||
|
|
osgish is distributed in the hope that it will be useful,
|
||
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
GNU General Public License for more details.
|
||
|
|
|
||
|
|
You should have received a copy of the GNU General Public License
|
||
|
|
along with osgish. If not, see <http://www.gnu.org/licenses/>.
|
||
|
|
|
||
|
|
A commercial license is available as well. Please contact roland@cpan.org for
|
||
|
|
further details.
|
||
|
|
|
||
|
|
=head1 PROFESSIONAL SERVICES
|
||
|
|
|
||
|
|
Just in case you need professional support for this module (or JMX or OSGi in
|
||
|
|
general), you might want to have a look at www.consol.com Contact
|
||
|
|
roland.huss@consol.de for further information (or use the contact form at
|
||
|
|
http://www.consol.com/contact/)
|
||
|
|
|
||
|
|
=head1 AUTHOR
|
||
|
|
|
||
|
|
roland@cpan.org
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
1;
|
||
|
|
|