view release on metacpan or  search on metacpan

lib/JMX/Jmx4Perl.pm  view on Meta::CPAN

sub parse_name {
    my $self = shift;
    my $name = shift;
    my $escaped = shift;

    return undef unless $name =~ /:/;
    my ($domain,$rest) = split(/:/,$name,2);
    my $attrs = {};
    while ($rest =~ s/([^=]+)\s*=\s*//) {
        #print "R: $rest\n";
        my $key = $1;
        my $value = undef;
        if ($rest =~ /^"/) {
            $rest =~ s/("((\\"|[^"])+)")(\s*,\s*|$)//;
            $value = $escaped ? $1 : $2;
            # Unescape escaped chars
            $value =~ s/\\([:",=*?])/$1/g unless $escaped;
        } else {
            if ($rest =~ s/([^,]+)(\s*,\s*|$)//) {
                $value = $1;
            }
        }
        return undef unless defined($value);
        $attrs->{$key} = $value;
        #print "K: $key V: $value\n";
    }
    # If there is something left, we were not successful
    # in parsing the name
    return undef if $rest;
    return ($domain,$attrs);
}


=item $formatted_text = $jmx->formatted_list($path)

=item $formatted_text = $jmx->formatted_list($resp)

Get the a formatted string representing the MBeans as returnded by C<list()>.
C<$path> is the optional inner path for selecting only a subset of all mbean.
See C<list()> for more details. If called with a L<JMX::Jmx4Perl::Response>
object, the list and the optional path will be taken from the provided response
object and not fetched again from the server.

=cut

sub formatted_list {
    my $self = shift;
    my $path_or_resp = shift;
    my $path;
    my $list;

    if ($path_or_resp && UNIVERSAL::isa($path_or_resp,"JMX::Jmx4Perl::Response")) {
        $path = $path_or_resp->request->get("path");
        $list = $path_or_resp->value;
    } else {
        $path = $path_or_resp;
        $list = $self->list($path);
    }
    my @path = ();
    @path = split m|/|,$path if $path;
    #print Dumper(\@path);
    croak "A path can be used only for a domain name or MBean name" if @path > 2;
    my $intent = "";
    my $ret = &_format_map("",$list,\@path,0);
}


# ===============================================================================================

# Helper method for extracting parameters for the set/get methods.
sub _extract_get_set_parameters {
    my $self = shift;
    my %args = @_;
    my $p = $args{params};
    my $f = $p->[0];
    my $with_value = $args{with_value};
    my ($object,$attribute,$path,$value);
    if (ref($f) eq "HASH") {
        $value = $f->{value};
        if ($f->{alias}) {
            my $alias_path;
            ($object,$attribute,$alias_path) =
              $self->resolve_alias($f->{alias});
            if (ref($object) eq "CODE") {
                # Let the handler do it
                return ($object,undef,undef,$args{with_value} ? $value : undef);
            }
            croak "No alias ",$f->{alias}," defined for handler ",$self->product->name unless $object;
            if ($alias_path) {
                $path = $f->{path} ? $f->{path} . "/" . $alias_path : $alias_path;
            } else {
                $path = $f->{path};
            }
        } else {
            $object = $f->{mbean} || $self->_glue_mbean_name($f) ||
              croak "No MBean name or domain + properties given";
            $attribute = $f->{attribute};
            $path = $f->{path};
        }
    } else {
        if ( (@{$p} == 1 && !$args{with_value}) ||
             (@{$p} == 2 && $args{with_value}) || $self->_is_alias($p->[0])) {
            # A single argument can only be used as an alias
            ($object,$attribute,$path) =
              $self->resolve_alias($f);
            $value = $_[1];
            if (ref($object) eq "CODE") {
                # Let the handler do it
                return ($object,undef,undef,$args{with_value} ? $value : undef);
            }
            croak "No alias ",$f," defined for handler ",$self->product->name unless $object;
        } else {
            if ($args{with_value}) {
                ($object,$attribute,$value,$path) = @{$p};
            } else {
                ($object,$attribute,$path) = @{$p};
            }
        }
    }
    return ($object,$attribute,$path,$value);