jmx4perl/t/30_request.t

76 lines
2.1 KiB
Perl

#!/usr/bin/perl
use strict;
use warnings;
use FindBin qw($Bin);
use lib qq($Bin/lib);
use Test::More tests => 30;
BEGIN { use_ok("JMX::Jmx4Perl::Request"); }
ok(READ eq "read","Import of constants");
my $names =
{
"jmx4perl.it:name=\"name\\*with\\?strange=\\\"chars\",type=escape" => 0,
"*:*" => 1,
"*:type=bla" => 1,
"domain:*" => 1,
"domain:name=blub,*" => 1,
"domain:name=*,type=blub" => 1,
"domain:name=*,*" => 1,
"domain:name=\"\\*\",type=blub" => 0,
"domain:name" => 0,
"domain:name=Bla*blub" => 1,
"domain:name=\"Bla\\*blub\"" => 0,
"domain:name=\"Bla\\*?blub\"" => 1,
"domain:name=\"Bla\\*\\?blub\"" => 0,
"domain:name=\"Bla\\*\\?blub\",type=?" => 1,
"do*1:name=bla" => 1,
"do?1:name=bla" => 1
};
for my $name (keys %$names) {
my $req = new JMX::Jmx4Perl::Request(READ,$name,"attribute");
my $is_pattern = $req->is_mbean_pattern;
is($is_pattern,$names->{$name},"Pattern: $name");
}
# Check for autodetection of requests
my $name="domain:attr=val";
my $req = new JMX::Jmx4Perl::Request(READ,$name,"attribute");
is($req->method(),undef,"Method not defined");
$req = new JMX::Jmx4Perl::Request(READ,$name,"attribute",{method => "PoSt"});
is($req->method(),"POST","Post method");
$req = new JMX::Jmx4Perl::Request(READ,$name,["a1","a2"]);
is($req->method(),"POST","Read with attribute refs need POST");
eval {
$req = new JMX::Jmx4Perl::Request(READ,$name,["a1","a2"],{method => "GET"});
};
ok($@,"No attributes with GET");
# Regexp for squeezing trailing slashes (RT#89108)
my $regexps = {
new => 's|((?:!/)?/)/*|$1|g',
old => 's|(!/)?/+|$1/|g'
};
my $data = {
'!////' => '!//',
'////' => '/',
'/' => '/',
'!/' => '!/'
};
for my $d (keys %$data) {
no warnings;
for my $re (keys %$regexps) {
my $test = $d;
my $expected = $data->{$d};
eval '$^W = 0; $test =~ ' . $regexps->{$re};
is($test,$expected,"Squeezing regexp '" . $re ."' : ".$d." --> ".$test);
}
}