use strict;
use warnings;
use Test::More tests => 6;
use Data::Dumper;


rt(
    'Net::IMP::Pattern',
    [
	# different perl versions use different rx stringifications
	'action=deny&adata=matched%20regex&rx=(?^:foo%25bar%20foot)&rxlen=12',
	'action=deny&adata=matched%20regex&rx=(?-xism:foo%25bar%20foot)&rxlen=12',
    ],
    {
	action => 'deny',
	adata  => 'matched regex',
	rx => qr/foo%bar foot/,
	rxlen => '12',
    }
);

rt(
    'Net::IMP::ProtocolPinning',
    [
	# different perl versions use different rx stringifications
	'dir0=0&dir1=1&ignore_order=1&max_unbound0=0&max_unbound1=0&rx0=(?^:\d{4})&rx1=(?^:%20\r?\n\r?\n)&rxlen0=4&rxlen1=5',
	'dir0=0&dir1=1&ignore_order=1&max_unbound0=0&max_unbound1=0&rx0=(?-xism:\d{4})&rx1=(?-xism:%20\r?\n\r?\n)&rxlen0=4&rxlen1=5',
    ],
    {
	rules => [
	    { dir => '0', rxlen => '4', rx => qr/\d{4}/ },
	    { dir => '1', rxlen => '5', rx => qr/ \r?\n\r?\n/ },
	],
	max_unbound => ['0','0'],
	ignore_order => '1',
    }
);

rt(
    'Net::IMP::ProtocolPinning',
    [
	# different perl versions use different rx stringifications
	'dir0=0&ignore_order=1&max_unbound0&max_unbound1=0&rx0=(?^:\d{4})&rxlen0=4',
	'dir0=0&ignore_order=1&max_unbound0&max_unbound1=0&rx0=(?-xism:\d{4})&rxlen0=4',
    ],
    {
	rules => [ { dir => '0', rxlen => '4', rx => qr/\d{4}/ }, ],
	max_unbound => [undef,'0'],
	ignore_order => '1',
    }
);

sub rt {
    my ($class,$str,$cfg) = @_;
    eval "require $class" or BAIL_OUT("cannot load $class");
    my @str = ref($str) ? (@$str):($str);

    my $str2 = $class->cfg2str(%$cfg);
    if ( grep { $_ eq $str2 } @str ) {
	pass("$class cfg2str");
    } else {
	diag("$str2 does not match any of @str");
	fail("$class cfg2str");
    }

    my $ok = 0;
    for my $str ( @str ) {
	my %cfg2;
	eval { %cfg2 = $class->str2cfg($str) }
	    # maybe unsupported regex syntax for this perl version
	    or next;
	my $dp2 = Dumper(\%cfg2);
	# $rx = qr/$rx/; $rx = qr/$rx/ will put twice into (?^:...
	my $prefix = qr{\?(?:\^|-xism):};
	$dp2 =~s{qr/\($prefix(\($prefix.*?\))\)/}{qr/$1/}g;
	if ( $dp2 eq Dumper($cfg) ) {
	    pass("$class str2cfg");
	    $ok = 1;
	    last;
	} else {
	    diag("$dp2\nvs\n".Dumper($cfg));
	}
    }
    fail("$class str2cfg") if ! $ok;

}