76 lines
2.1 KiB
Perl
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);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|