TT#32600 block grep, block map percritic fixes

fix perlcritic issues (around 50):
Policy::BuiltinFunctions::RequireBlockGrep
Policy::BuiltinFunctions::RequireBlockMap

Change-Id: I100565ad3b0d643d7b38c304ab75e600383b8ad0
changes/21/19121/3
Gerhard Jungwirth 8 years ago
parent 4bcd90c311
commit c9e0723db6

@ -92,7 +92,7 @@ sub _item_rs {
my $profile = $c->user->voip_subscriber_profile;
if($profile) {
my $attrs = [ map { $_->attribute->attribute } $profile->profile_attributes->all ];
if(grep(/^fax_server$/, @{ $attrs })) {
if(grep { /^fax_server$/ } @{ $attrs }) {
$faxserver &= 1;
} else {
$faxserver = 0;

@ -73,8 +73,8 @@ sub _load_servers {
my $host_rs = $c->model('DB')->resultset('xmlgroups')
->search_rs({name => 'xmpp'})
->search_related('xmlhostgroups')->search_related('host');
return [map +{ip => $_->ip, port => $_->port, path => $_->path,
id => $_->id}, $host_rs->all];
return [map { +{ip => $_->ip, port => $_->port, path => $_->path,
id => $_->id} } $host_rs->all];
}
1;

@ -20,8 +20,9 @@ sub dispatch {
my $host_rs = $schema->resultset('xmlgroups')
->search_rs({name => $target})
->search_related('xmlhostgroups')->search_related('host', {}, { order_by => 'id' });
$hosts = [map +{ip => $_->ip, port => $_->port, path => $_->path,
id => $_->id}, $host_rs->all];
$hosts = [map { +{ip => $_->ip, port => $_->port, path => $_->path,
id => $_->id} } $host_rs->all];
use DDP; p $hosts;
}
use Data::Dumper;

@ -62,8 +62,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}

@ -22,8 +22,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}
@ -160,12 +160,12 @@ my @allprofiles = ();
my $opts = JSON::from_json($res->decoded_content);
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS PUT PATCH )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
foreach my $opt(qw( POST DELETE )) {
ok(!grep(/^$opt$/, @hopts), "check for absence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "check for absence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "check for absence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "check for absence of '$opt' in body");
}
$req = HTTP::Request->new('GET', $uri.'/'.$firstprofile);

@ -27,8 +27,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}
@ -242,12 +242,12 @@ my @allcontracts = ();
my $opts = JSON::from_json($res->decoded_content);
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS PUT PATCH )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
foreach my $opt(qw( POST DELETE )) {
ok(!grep(/^$opt$/, @hopts), "check for absence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "check for absence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "check for absence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "check for absence of '$opt' in body");
}
$req = HTTP::Request->new('GET', $uri.'/'.$firstcontract);

@ -21,8 +21,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}
@ -160,12 +160,12 @@ my @allcontacts = ();
my $opts = JSON::from_json($res->decoded_content);
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS PUT PATCH DELETE )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
my $opt = 'POST';
ok(!grep(/^$opt$/, @hopts), "check for absence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "check for absence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "check for absence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "check for absence of '$opt' in body");
$req = HTTP::Request->new('GET', $uri.'/'.$firstcontact);
$res = $ua->request($req);

@ -28,8 +28,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}
@ -272,12 +272,12 @@ my @allcustomers = ();
my $opts = JSON::from_json($res->decoded_content);
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS PUT PATCH )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
foreach my $opt(qw( POST DELETE )) {
ok(!grep(/^$opt$/, @hopts), "check for absence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "check for absence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "check for absence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "check for absence of '$opt' in body");
}
$req = HTTP::Request->new('GET', $uri.'/'.$firstcustomer);

@ -2369,8 +2369,8 @@ sub _test_journal_options_head {
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
$req = HTTP::Request->new('HEAD', $url);
$res = $ua->request($req);

@ -27,8 +27,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}

@ -22,8 +22,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}
@ -248,12 +248,12 @@ my @allresellers = ();
my $opts = JSON::from_json($res->decoded_content);
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS PUT PATCH )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
foreach my $opt(qw( POST DELETE )) {
ok(!grep(/^$opt$/, @hopts), "check for absence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "check for absence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "check for absence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "check for absence of '$opt' in body");
}
$req = HTTP::Request->new('GET', $uri.'/'.$firstreseller);

@ -27,12 +27,12 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
foreach my $opt(qw( PUT POST DELETE )) {
ok(!grep(/^$opt$/, @hopts), "check for non-existence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "check for non-existence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "check for non-existence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "check for non-existence of '$opt' in body");
}
my @links = $res->header('Link');

@ -23,8 +23,8 @@ $ua = Test::Collection->new()->ua();
my @hopts = split /\s*,\s*/, $res->header('Allow');
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS POST )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
}
@ -123,12 +123,12 @@ my @allcontacts = ();
my $opts = JSON::from_json($res->decoded_content);
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "check for valid 'methods' in body");
foreach my $opt(qw( GET HEAD OPTIONS PUT PATCH DELETE )) {
ok(grep(/^$opt$/, @hopts), "check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "check for existence of '$opt' in body");
}
my $opt = 'POST';
ok(!grep(/^$opt$/, @hopts), "check for absence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "check for absence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "check for absence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "check for absence of '$opt' in body");
$req = HTTP::Request->new('GET', $uri.'/'.$firstcontact);
$res = $ua->request($req);

@ -331,9 +331,9 @@ sub test_allowed_methods {
$self->_inc_test_count;
while((my $opt = shift @{ $expected })) {
ok(grep(/^$opt$/, @hopts), "$name - '$opt' in Allow header");
ok(grep { /^$opt$/ } @hopts, "$name - '$opt' in Allow header");
$self->_inc_test_count;
ok(grep(/^$opt$/, @{ $methods }), "$name - '$opt' in body");
ok(grep { /^$opt$/ } @{ $methods }, "$name - '$opt' in body");
$self->_inc_test_count;
}
is(@{ $expected }, 0, "$name - no leftover in allowed methods");
@ -521,7 +521,7 @@ sub _test_item {
$self->_test_fields($args->{skip_test_fields}, $args->{expected_fields}, $ref, $item, $name);
my %links = map { $_ => 0 } @{ $args->{expected_links} };
foreach my $link(keys %{ $item->{_links} }) {
next if(grep(/^$link$/, qw/self curies profile collection/));
next if(grep { /^$link$/ } qw/self curies profile collection/);
ok(exists $links{$link}, "$name - existence of link $link in reference");
$self->_inc_test_count;
delete $links{$link};

@ -824,11 +824,11 @@ sub check_methods{
ok(exists $opts->{methods} && ref $opts->{methods} eq "ARRAY", "$self->{name}: check for valid 'methods' in body");
foreach my $opt(keys %{$self->methods->{$area}->{all}} ) {
if(exists $self->methods->{$area}->{allowed}->{$opt}){
ok(grep(/^$opt$/, @hopts), "$self->{name}: check for existence of '$opt' in Allow header");
ok(grep(/^$opt$/, @{ $opts->{methods} }), "$self->{name}: check for existence of '$opt' in body");
ok(grep { /^$opt$/ } @hopts, "$self->{name}: check for existence of '$opt' in Allow header");
ok(grep { /^$opt$/ } @{ $opts->{methods} }, "$self->{name}: check for existence of '$opt' in body");
}else{
ok(!grep(/^$opt$/, @hopts), "$self->{name}: check for absence of '$opt' in Allow header");
ok(!grep(/^$opt$/, @{ $opts->{methods} }), "$self->{name}: check for absence of '$opt' in body");
ok(!grep { /^$opt$/ } @hopts, "$self->{name}: check for absence of '$opt' in Allow header");
ok(!grep { /^$opt$/ } @{ $opts->{methods} }, "$self->{name}: check for absence of '$opt' in body");
}
}
}

@ -205,7 +205,7 @@ say "Processing done, collecting final status...";
if($pid > 0) {
my $last_kids = @kids;
while((my $child_pid = wait()) > 0 && @kids) {
@kids = grep(!/^$child_pid$/, @kids);
@kids = grep { !/^$child_pid$/ } @kids;
if(@kids == $last_kids) {
sleep 1;
}

Loading…
Cancel
Save