Some perlcritic fixes

apply.cgi

@@ -2,7 +2,7 @@
 # apply.cgi
 # Apply the current configuration
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

create_table.cgi

@@ -2,7 +2,7 @@
 # create_table.cgi
 # Create a new nftables table
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

delete_chain.cgi

@@ -2,7 +2,7 @@
 # delete_chain.cgi
 # Delete an existing nftables chain
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

delete_table.cgi

@@ -2,7 +2,7 @@
 # delete_table.cgi
 # Delete an existing nftables table
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

edit_chain.cgi

@@ -2,7 +2,7 @@
 # edit_chain.cgi
 # Display a form for creating or editing a chain
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

edit_rule.cgi

@@ -2,7 +2,7 @@
 # edit_rule.cgi
 # Display a form for creating or editing a rule
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text, %config);
@@ -24,12 +24,12 @@ my $advanced_open;
 sub split_multi_value
 {
     my ($v) = @_;
-    return undef if (!defined($v) || $v eq '');
+    return if (!defined($v) || $v eq '');
     $v =~ s/^\s*\{//;
     $v =~ s/\}\s*$//;
     $v =~ s/^\s+//;
     $v =~ s/\s+$//;
-    return undef if ($v eq '');
+    return if ($v eq '');
     my @vals = split(/\s*,\s*/, $v);
     @vals = grep { $_ ne '' } @vals;
     return \@vals;

index.cgi

@@ -2,7 +2,7 @@
 # index.cgi
 # Display current nftables configuration
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text, %config);

move_rule.cgi

@@ -2,7 +2,7 @@
 # move_rule.cgi
 # Move a rule up or down within a chain
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

nftables-lib.pl

@@ -1,7 +1,7 @@
 # nftables-lib.pl
 # Functions for reading and writing nftables rules
 
-BEGIN { push(@INC, ".."); };
+BEGIN { push(@INC, ".."); }; ## no critic
 use WebminCore;
 use strict;
 use warnings;
@@ -28,7 +28,13 @@ my $table;
 my $chain;
 my $lnum = 0;
 my $content;
-open(my $fh, $file);
+my $fh;
+if ($file =~ /\|\s*$/) {
+    (my $pipe_cmd = $file) =~ s/\|\s*$//;
+    open($fh, '-|', $pipe_cmd);
+} else {
+    open($fh, '<', $file);
+}
 $content = do { local $/; <$fh> };
 close($fh);
 
@@ -194,13 +200,13 @@ return 1;
 sub move_rule_in_chain
 {
 my ($table, $chain, $idx, $dir) = @_;
-return undef if (!defined($table) || ref($table) ne 'HASH');
-return undef if (!defined($idx) || $idx !~ /^\d+$/);
-return undef if (!defined($chain) || $chain eq '');
-return undef if (!$table->{'rules'} || ref($table->{'rules'}) ne 'ARRAY');
-return undef if ($idx > $#{$table->{'rules'}});
+return if (!defined($table) || ref($table) ne 'HASH');
+return if (!defined($idx) || $idx !~ /^\d+$/);
+return if (!defined($chain) || $chain eq '');
+return if (!$table->{'rules'} || ref($table->{'rules'}) ne 'ARRAY');
+return if ($idx > $#{$table->{'rules'}});
 my $rule = $table->{'rules'}->[$idx];
-return undef if (!$rule || $rule->{'chain'} ne $chain);
+return if (!$rule || $rule->{'chain'} ne $chain);
 
 my @chain_idxs;
 for (my $i = 0; $i < @{$table->{'rules'}}; $i++) {
@@ -215,7 +221,7 @@ for (my $i = 0; $i <= $#chain_idxs; $i++) {
         last;
     }
 }
-return undef if (!defined($pos));
+return if (!defined($pos));
 
 my $swap;
 if ($dir eq 'up') {
@@ -227,7 +233,7 @@ elsif ($dir eq 'down') {
     $swap = $chain_idxs[$pos+1];
 }
 else {
-    return undef;
+    return;
 }
 
 ($table->{'rules'}->[$idx], $table->{'rules'}->[$swap]) =
@@ -245,7 +251,7 @@ sub format_addr_expr
 {
 my ($dir, $rule) = @_;
 my $val = $rule->{$dir};
-return undef if (!defined($val) || $val eq '');
+return if (!defined($val) || $val eq '');
 my $fam = &guess_addr_family($val, $rule->{$dir."_family"});
 return $fam." ".$dir." ".$val;
 }
@@ -254,7 +260,7 @@ sub format_l4proto_expr
 {
 my ($rule) = @_;
 my $proto = $rule->{'l4proto'};
-return undef if (!defined($proto) || $proto eq '');
+return if (!defined($proto) || $proto eq '');
 my $fam = $rule->{'l4proto_family'} || 'meta';
 if ($fam eq 'ip' || $fam eq 'ip6') {
     return $fam." protocol ".$proto;
@@ -266,7 +272,7 @@ sub format_port_expr
 {
 my ($dir, $rule) = @_;
 my $val = $rule->{$dir};
-return undef if (!defined($val) || $val eq '');
+return if (!defined($val) || $val eq '');
 my $proto;
 if ($dir eq 'sport') {
     $proto = $rule->{'sport_proto'} || $rule->{'proto'} || $rule->{'l4proto'};
@@ -274,14 +280,14 @@ if ($dir eq 'sport') {
 else {
     $proto = $rule->{'proto'} || $rule->{'l4proto'};
 }
-return undef if (!defined($proto) || $proto eq '');
+return if (!defined($proto) || $proto eq '');
 return $proto." ".$dir." ".$val;
 }
 
 sub format_tcp_flags_expr
 {
 my ($rule) = @_;
-return undef if (!defined($rule->{'tcp_flags'}) || $rule->{'tcp_flags'} eq '');
+return if (!defined($rule->{'tcp_flags'}) || $rule->{'tcp_flags'} eq '');
 my $val = $rule->{'tcp_flags'};
 if (defined($rule->{'tcp_flags_mask'}) && $rule->{'tcp_flags_mask'} ne '') {
     return "tcp flags & ".$rule->{'tcp_flags_mask'}." == ".$val;
@@ -292,7 +298,7 @@ return "tcp flags ".$val;
 sub format_limit_expr
 {
 my ($rule) = @_;
-return undef if (!defined($rule->{'limit_rate'}) || $rule->{'limit_rate'} eq '');
+return if (!defined($rule->{'limit_rate'}) || $rule->{'limit_rate'} eq '');
 my $out = "limit rate ".$rule->{'limit_rate'};
 if (defined($rule->{'limit_burst'}) && $rule->{'limit_burst'} ne '') {
     my $burst = $rule->{'limit_burst'};
@@ -305,7 +311,7 @@ return $out;
 sub format_log_expr
 {
 my ($rule) = @_;
-return undef if (!$rule->{'log'} && !$rule->{'log_prefix'} && !$rule->{'log_level'});
+return if (!$rule->{'log'} && !$rule->{'log_prefix'} && !$rule->{'log_level'});
 my @p = ("log");
 if (defined($rule->{'log_prefix'}) && $rule->{'log_prefix'} ne '') {
     my $pfx = &escape_nft_string($rule->{'log_prefix'});
@@ -808,7 +814,7 @@ my $file = $config{'save_file'} || "$module_config_directory/nftables.conf";
 if ($config{'direct'}) {
     return &apply_restore($file);
 }
-return undef;
+return;
 }
 
 # apply_restore([file])
@@ -822,7 +828,7 @@ my $out = &backquote_logged("$cmd -f $file 2>&1");
 if ($?) {
     return "<pre>$out</pre>";
 }
-return undef;
+return;
 }
 
 # describe_rule(&rule)

rename_chain.cgi

@@ -2,7 +2,7 @@
 # rename_chain.cgi
 # Rename an existing chain
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

save_chain.cgi

@@ -2,7 +2,7 @@
 # save_chain.cgi
 # Save a new or existing chain
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text);

save_rule.cgi

@@ -2,7 +2,7 @@
 # save_rule.cgi
 # Save a new or existing rule
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text, %config);
@@ -14,10 +14,10 @@ my $table = $tables[$in{'table'}];
 sub join_multi_value
 {
     my ($v) = @_;
-    return undef if (!defined($v) || $v eq '');
+    return if (!defined($v) || $v eq '');
     my @vals = split(/\0/, $v);
     @vals = grep { defined($_) && $_ ne '' } @vals;
-    return undef if (!@vals);
+    return if (!@vals);
     return join(",", @vals);
 }
 

setup.cgi

@@ -2,7 +2,7 @@
 # setup.cgi
 # Create a default nftables ruleset
 
-require './nftables-lib.pl';
+require './nftables-lib.pl'; ## no critic
 use strict;
 use warnings;
 our (%in, %text, %config);

t/perlcritic.t

@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+    eval { require Perl::Critic; 1 }
+        or plan skip_all => 'Perl::Critic not installed';
+}
+
+use File::Find;
+
+sub script_dir
+{
+    my $path = $0;
+    if ($path =~ m{^/}) {
+        $path =~ s{/[^/]+$}{};
+        return $path;
+    }
+    my $cwd = `pwd`;
+    chomp($cwd);
+    if ($path =~ m{/}) {
+        $path =~ s{/[^/]+$}{};
+        return $cwd.'/'.$path;
+    }
+    return $cwd;
+}
+
+my $bindir = &script_dir();
+my $module_dir = "$bindir/..";
+chdir($module_dir) or die "chdir: $!";
+
+my @files;
+find(
+    sub {
+        return if -d;
+        return unless /\.(pl|cgi)\z/;
+        push(@files, $File::Find::name);
+    },
+    '.'
+);
+
+@files = sort @files;
+if (!@files) {
+    plan skip_all => 'no perl files to check';
+}
+
+my $critic = Perl::Critic->new(
+    -severity => 5,
+    -profile => '',
+);
+
+foreach my $file (@files) {
+    my @violations = $critic->critique($file);
+    is(scalar @violations, 0, "$file perlcritic");
+    if (@violations) {
+        diag join("", @violations);
+    }
+}
+
+done_testing();