The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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);
    }
}