From: Sergey Matveev Date: Thu, 15 May 2025 08:37:44 +0000 (+0300) Subject: perlcritic X-Git-Url: http://www.git.stargrave.org/?a=commitdiff_plain;h=42e07b69da9e65d80832a140766bebeb79c64e7f;p=swg.git perlcritic --- diff --git a/zk b/zk index 250f8ff..ef115e8 100755 --- a/zk +++ b/zk @@ -5,28 +5,36 @@ use strict; use warnings; use utf8; +use Carp q{croak}; + +use version; our $VERSION = qv('1.0.0'); + use Encode qw(encode decode); -binmode STDOUT, ":encoding(UTF-8)"; +binmode STDOUT, q{:encoding(UTF-8)}; + +my $CR = "\r"; sub usage { - print STDERR "Usage: -\t$0 links PAGE -\t$0 backs PAGE -\t$0 cats [PREFIX] -\t$0 htmls DIR -\t$0 dot | dot -Tpng >relations.png -\t$0 info >out.info + print {*STDERR} <<"END_USAGE" +Usage: + $0 links PAGE + $0 backs PAGE + $0 cats [PREFIX] + $0 htmls DIR + $0 dot | dot -Tpng >relations.png + $0 info >out.info By default ZK_DO_BACKS=1 is set. Do not forget about .zkignore with regular expressions. -"; +END_USAGE +; exit 1; } -usage if $#ARGV == -1; +if ($#ARGV == -1) { usage } my $DoBacks = ((not exists $ENV{ZK_DO_BACKS}) or - ($ENV{ZK_DO_BACKS} eq "1")) ? 1 : 0; + ($ENV{ZK_DO_BACKS} eq q{1})) ? 1 : 0; my %Mtimes; my %Lines; @@ -36,18 +44,21 @@ my %CatDirs; sub noindex { $_ = shift; /(.*\/)index$/; - return (defined $1) ? $1 : $_; + if (defined $1) { + return $1; + } + return $_; } { my @ignores; - if (-e ".zkignore") { - open my $fh, "<:encoding(UTF-8)", ".zkignore" or die "$!"; + if (-e q{.zkignore}) { + open my $fh, q{<:encoding(UTF-8)}, q{.zkignore} or croak "$!"; while (<$fh>) { chop; push @ignores, $_; } - close $fh; + close $fh or croak "$!"; } sub isignored { my $p = shift; @@ -59,43 +70,46 @@ sub noindex { use File::Find; use POSIX qw(strftime); my $pth; + my $mtime; sub wanted { my $fn = $_; - return if ($fn =~ /^\./) and ($fn ne "."); + return if ($fn =~ /^[.]/) && ($fn ne q{.}); $pth = $File::Find::name; - $pth = decode "UTF-8", $pth; - $pth =~ s/^\.\/?//; + $pth = decode q{UTF-8}, $pth; + $pth =~ s/^[.][\/]?//; if (-d $fn) { return if isignored "$pth/"; - opendir(my $dh, $fn) or die "$!"; + opendir my $dh, $fn or croak "$!"; my @_files; my @_dirs; while (readdir $dh) {; - next if /^\./; - $_ = decode "UTF-8", $_; + next if /^[.]/; + $_ = decode q{UTF-8}, $_; if (-d "$fn/$_") { - next if isignored(($fn eq ".") ? $_ : "$fn/$_/"); + next if isignored(($fn eq q{.}) ? $_ : "$fn/$_/"); $_ = "$pth/$_/"; s/^\///; push @_dirs, $_; } else { - next if isignored(($fn eq ".") ? $_ : "$fn/$_"); + next if isignored(($fn eq q{.}) ? $_ : "$fn/$_"); $_ = "$pth/$_"; s/^\///; push @_files, $_; } } - closedir $dh; + closedir $dh or croak "$!"; $CatFiles{"$pth/"} = \@_files; $CatDirs{"$pth/"} = \@_dirs; } else { return if isignored $pth; - my @s = stat($fn) or die "$!"; - $Mtimes{$pth} = strftime "%Y-%m-%d %H:%M:%S", gmtime $s[9]; + (undef, undef, undef, undef, undef, undef, undef, undef, undef, + $mtime, undef, undef, undef) = stat $fn or croak "$!"; + $Mtimes{$pth} = strftime q{%Y-%m-%d %H:%M:%S}, gmtime $mtime; } + return; } my %opts = (wanted => \&wanted, follow => 1); - find(\%opts, "."); + find(\%opts, q{.}); } my %Links; @@ -105,33 +119,42 @@ for my $pth (keys %Mtimes) { my $lines = 0; my sub procline; sub procline { - if (/^<<.*\[(.*)\] $/) { + my ($line) = @_; + if (/^<<.*\[(.*)\]${CR}$/) { $found{$1} = 1; - open(my $fh, "<:encoding(UTF-8)", $1) or die "$!"; + open my $fh, q{<:encoding(UTF-8)}, $1 or croak "$!"; while (<$fh>) { $lines++; procline $_ } - close $fh; + close $fh or croak "$!"; return; } - foreach my $w (split /\s+/, $_[0]) { - next unless $w =~ /\[([^]]+)\]/; - $w = $1; + foreach my $w (split /\s+/, $line) { + if ($w =~ /\[([^]]+)\]/) { + $w = $1; + } else { + next; + } if ($w =~ /\/$/) { if (not exists $CatDirs{$w}) { - print "missing $w\n" if exists $ENV{ZK_PRINT_MISSING}; + if (exists $ENV{ZK_PRINT_MISSING}) { + print "missing $w\n"; + } return; } } else { if (not exists $Mtimes{$w}) { - print "missing $w\n" if exists $ENV{ZK_PRINT_MISSING}; + if (exists $ENV{ZK_PRINT_MISSING}) { + print "missing $w\n"; + } return; } } $found{$w} = 1; } + return; } - open(my $fh, "<:encoding(UTF-8)", $pth) or die "$!"; + open my $fh, q{<:encoding(UTF-8)}, $pth or croak "$!"; while (<$fh>) { $lines++; procline $_ } - close $fh; + close $fh or croak "$!"; $Lines{$pth} = $lines; my @ws = sort keys %found; next if $#ws == -1; @@ -151,14 +174,14 @@ sub genIndex { my $page = shift; my $ctr = 0; my $pth; - print $out " Links:\n"; + print {$out} " Links:\n"; foreach (sort @{$CatFiles{$page}}) { - printf $out "%3d % -39s %s %8d\n", $ctr, "[$_]", $Mtimes{$_}, $Lines{$_}; + printf {$out} "%3d % -39s %s %8d\n", $ctr, "[$_]", $Mtimes{$_}, $Lines{$_}; $ctr++; } my @links = sort @{$CatDirs{$page}}; if ($#links != -1) { - print $out "\n Subcategories:\n"; + print {$out} "\n Subcategories:\n"; $ctr = 0; my @entries; my $count; @@ -167,19 +190,20 @@ sub genIndex { $count = 1 + $#entries; @entries = @{$CatDirs{$_}}; $count += 1 + $#entries; - printf $out "%3d % -64s %3d\n", $ctr, "[$_]", $count; + printf {$out} "%3d % -64s %3d\n", $ctr, "[$_]", $count; $ctr++; } } - print $out "do-backs \n"; + print {$out} "do-backs${CR}\n"; + return; } sub genIndex2Buf { my $p = shift; - my $buf = ""; - open(my $fh, ">:encoding(UTF-8)", \$buf) or die "$!"; + my $buf = q{}; + open my $fh, q{>:encoding(UTF-8)}, \$buf or croak "$!"; genIndex $fh, $p; - close $fh; + close $fh or croak "$!"; return $buf; } @@ -211,72 +235,80 @@ sub genHTML { @rels = (); my $rel; foreach (@links) { - $rel = ($page eq "/") ? "$_" : File::Spec->abs2rel($_, $page); - if (not $page =~ /\/$/) { - $rel = (length $rel > 2) ? (substr $rel, 3) : ""; + $rel = ($page eq q{/}) ? "$_" : File::Spec->abs2rel($_, $page); + if ($page !~ /\/$/) { + $rel = (length $rel > 2) ? (substr $rel, 3) : q{}; } - if (-d $_) { - unless ($rel =~ /\/$/) { - $rel .= "/"; + if (-d) { + if ($rel !~ /\/$/) { + $rel .= q{/}; } - $rel .= "index"; + $rel .= q{index}; } push @rels, $rel; } + return; } makerels; { my $title = noindex $page; - my $fn = ($page =~ /\/$/) ? "index" : basename $page; - print $out " + my $fn = ($page =~ /\/$/) ? q{index} : basename $page; + print {$out} <<"END_HTML" + $title -
";
+
+END_HTML
     }
-    my $indent = "";
+    my $indent = q{};
     my sub procline;
     sub procline {
         $_ = shift;
         chop;
-        if (/
$/) {
+        if (/${CR}$/) {
             chop;
-            /^(\s*)(.*)$/;
-            my $head = $1;
-            my @cols = split /\s+/, $2;
-            if ($cols[0] eq "=>") {
-                my $t = ($#cols > 1) ? (join " ", @cols[2..$#cols]) : $cols[1];
+            my $head = q{};
+            my @cols;
+            if (/^(\s*)(.*)$/) {
+                $head = $1;
+                @cols = split /\s+/, $2;
+            } else {
+                @cols = split /\s+/;
+            }
+            if ($cols[0] eq q{=>}) {
+                my $t = ($#cols > 1) ? (join q{ }, @cols[2..$#cols]) : $cols[1];
                 $t = htmlescape $t;
                 $t =~ s/"/\&guot;/g;
                 $_ = "$head=> $t";
-            } elsif ($cols[0] eq "img") {
+            } elsif ($cols[0] eq q{img}) {
                 if ($#cols > 1) {
-                    my $t = htmlescape join " ", @cols[2..$#cols];
+                    my $t = htmlescape join q{ }, @cols[2..$#cols];
                     $t =~ s/"/\&guot;/g;
                     $_ = "$head\"$t\"";
                 } else {
                     $_ = "$head";
                 }
-            } elsif ($cols[0] eq "do-backs") {
+            } elsif ($cols[0] eq q{do-backs}) {
                 $doBacks = 1;
                 return;
             } elsif (/^\s*#/) {
                 return;
-            } elsif (/^\s*\|/) {
-                $_ = $head . substr $_, 1 + (index $_, "|");
+            } elsif (/^\s*[|]/) {
+                $_ = $head . substr $_, 1 + (index $_, q{|});
             } elsif (/^\s*<<(.*)\[([^[]+)\]/) {
                 my $indentOrig = $indent;
                 $indent .= "${head}$1";
-                open(my $fh, "<:encoding(UTF-8)", $2) or die "$!";
+                open my $fh, q{<:encoding(UTF-8)}, $2 or croak "$!";
                 while (<$fh>) { procline $_ }
-                close $fh;
+                close $fh or croak "$!";
                 $indent = $indentOrig;
                 return;
             } else {
-                die "unknown $cols[0] command: $page\n";
+                croak "unknown $cols[0] command: $page\n";
             }
         } else {
             $_ = htmlescape $_;
@@ -286,35 +318,36 @@ sub genHTML {
                 }
             }
         }
-        print $out "${indent}$_\n";
+        print {$out} "${indent}$_\n";
+        return;
     }
     {
         my $fh;
         if (defined $buf) {
-            open($fh, "<:encoding(UTF-8)", \$buf) or die "$!";
+            open $fh, q{<:encoding(UTF-8)}, \$buf or croak "$!";
         } else {
-            open($fh, "<:encoding(UTF-8)", $page) or die "$!";
+            open $fh, q{<:encoding(UTF-8)}, $page or croak "$!";
         }
         while (<$fh>) { procline $_ }
-        close $fh;
+        close $fh or croak "$!";
     }
     @links = sort keys %{$Backs{noindex $page}};
-    my $backsWereGenerated = ($doBacks and $#links != -1) ? 1 : 0;
+    my $backsWereGenerated = ($doBacks && $#links != -1) ? 1 : 0;
     if ($backsWereGenerated) {
         makerels;
-        procline "|

\n";
-        print $out "        Backlinks:\n";
+        procline "|
${CR}\n";
+        print {$out} "        Backlinks:\n";
         my $ctr = 0;
         my $pth;
         foreach my $l (@links) {
             $pth = noindex $l;
-            procline sprintf("%3d % -39s %19s %8d\n",
-                $ctr, "[$pth]", ($Mtimes{$l} or ""), ($Lines{$l} or 0));
+            procline sprintf "%3d % -39s %19s %8d\n",
+                $ctr, "[$pth]", ($Mtimes{$l} or q{}), ($Lines{$l} or 0);
             $ctr++;
         }
     }
-    print $out "
\n";
-    print $out "\n";
+    print {$out} "
\n"; + print {$out} "\n"; return $backsWereGenerated; } @@ -325,7 +358,8 @@ sub nodename { } sub printMenuEntry { - print "* " . (nodename $_) . ": " . (nodename $_) . ".\n"; + print q{* } . (nodename $_) . q{: } . (nodename $_) . ".\n"; + return; } sub genInfo { @@ -342,24 +376,26 @@ sub genInfo { } my sub linked { my $n = shift; - return $n unless exists $links{$n}; + if (not exists $links{$n}) { + return $n; + } $n = nodename $n; return "[*note ${n}::]"; } - open(my $fh, "<:encoding(UTF-8)", $page) or die "$!"; + open my $fh, q{<:encoding(UTF-8)}, $page or croak "$!"; while (<$fh>) { chop; - if (/ $/) { + if (/${CR}$/) { chop; /^\s*(.*)$/; - if (($1 =~ /^#/) || ($1 =~ /^do-backs/)) { + if (($1 =~ /^#/) or ($1 =~ /^do-backs/)) { next; } } s/\[([^]]+)\]/linked $1/ge; print "$_\n"; } - close $fh; + close $fh or croak "$!"; my @backs = sort keys %{$Backs{noindex $page}}; if ($#backs != -1) { print "\n* Menu:\nBacklinks:\n"; @@ -368,6 +404,7 @@ sub genInfo { } print "\n"; } + return; } sub genInfoIndex { @@ -394,10 +431,11 @@ sub genInfoIndex { } print "\n"; } + return; } -if ($ARGV[0] eq "dump") { - use Data::Dumper; +if ($ARGV[0] eq q{dump}) { + require Data::Dumper; print Data::Dumper->Dump([ \%Links, \%Backs, @@ -407,31 +445,35 @@ if ($ARGV[0] eq "dump") { \%Lines, ], [qw(*Links *Backs *CatFiles *CatDirs *Mtimes *Lines)]); -} elsif ($ARGV[0] eq "links") { - my $p = decode "UTF-8", $ARGV[1]; - map { print "$_\n" } @{$Links{$p}}; -} elsif ($ARGV[0] eq "backs") { - my $p = decode "UTF-8", $ARGV[1]; - map { print "$_\n" } sort keys %{$Backs{$p}}; -} elsif ($ARGV[0] eq "cats") { - my $p = (defined $ARGV[1]) ? $ARGV[1] : ""; - $p = decode "UTF-8", $p; +} elsif ($ARGV[0] eq q{links}) { + my $p = decode q{UTF-8}, $ARGV[1]; + foreach (@{$Links{$p}}) { print "$_\n" } +} elsif ($ARGV[0] eq q{backs}) { + my $p = decode q{UTF-8}, $ARGV[1]; + foreach (sort keys %{$Backs{$p}}) { print "$_\n" } +} elsif ($ARGV[0] eq q{cats}) { + my $p = (defined $ARGV[1]) ? $ARGV[1] : q{}; + $p = decode q{UTF-8}, $p; foreach (sort keys %CatFiles) { - next unless /^$p/; - next if $_ eq ""; + if (not /^$p/) { + next; + } + if ($_ eq q{}) { + next; + } print "$_\n"; } -} elsif ($ARGV[0] eq "gen-index") { - my $p = decode "UTF-8", $ARGV[1]; +} elsif ($ARGV[0] eq q{gen-index}) { + my $p = decode q{UTF-8}, $ARGV[1]; genIndex \*STDOUT, $p; -} elsif ($ARGV[0] eq "gen-html") { - my $p = decode "UTF-8", $ARGV[1]; +} elsif ($ARGV[0] eq q{gen-html}) { + my $p = decode q{UTF-8}, $ARGV[1]; if ($p =~ /\/$/) { genHTML \*STDOUT, $p, genIndex2Buf $p; } else { genHTML \*STDOUT, $p; } -} elsif ($ARGV[0] eq "htmls") { +} elsif ($ARGV[0] eq q{htmls}) { my $now = time; use File::Path qw(make_path); use File::Copy; @@ -441,72 +483,73 @@ if ($ARGV[0] eq "dump") { make_path "$ARGV[1]/$cat"; next if (exists $Mtimes{"${cat}index"}); $fn = "$ARGV[1]/${cat}index.txt"; - open($fh, ">:encoding(UTF-8)", $fn) or die "$!"; + open $fh, q{>:encoding(UTF-8)}, $fn or croak "$!"; genIndex $fh, $cat; - close $fh; + close $fh or croak "$!"; utime $now, $now, $fn; $fn = "$ARGV[1]/${cat}index.html"; - open($fh, ">:encoding(UTF-8)", $fn) or die "$!"; + open $fh, q{>:encoding(UTF-8)}, $fn or croak "$!"; genHTML $fh, $cat, genIndex2Buf $cat; - close $fh; + close $fh or croak "$!"; utime $now, $now, $fn; } - my @s; + my $mtime; foreach my $pth (keys %Mtimes) { - open($fh, ">:encoding(UTF-8)", "$ARGV[1]/$pth.html") or die "$!"; + open $fh, q{>:encoding(UTF-8)}, "$ARGV[1]/$pth.html" or croak "$!"; my $backsWereGenerated = genHTML $fh, $pth; - close $fh; - @s = stat($pth) or die "$!"; + close $fh or croak "$!"; + (undef, undef, undef, undef, undef, undef, undef, undef, undef, + $mtime, undef, undef, undef) = stat $pth or croak "$!"; if ($backsWereGenerated) { utime $now, $now, "$ARGV[1]/$pth.html"; } else { - utime $s[9], $s[9], "$ARGV[1]/$pth.html"; + utime $mtime, $mtime, "$ARGV[1]/$pth.html"; } - copy $pth, "$ARGV[1]/$pth.txt" or die "$!"; - utime $s[9], $s[9], "$ARGV[1]/$pth.txt"; + copy $pth, "$ARGV[1]/$pth.txt" or croak "$!"; + utime $mtime, $mtime, "$ARGV[1]/$pth.txt"; } -} elsif ($ARGV[0] eq "info") { +} elsif ($ARGV[0] eq q{info}) { print "Autogenerated by zk\n"; my $sep = "\n\n"; print "${sep}File: self, Node: Top, Up: (dir)\n\n"; - if (exists $Mtimes{"index"}) { - genInfo "index"; - delete $Mtimes{"index"}; - delete $CatFiles{"/"}; + if (exists $Mtimes{q{index}}) { + genInfo q{index}; + delete $Mtimes{q{index}}; + delete $CatFiles{q{/}}; } else { - genInfoIndex "/"; - delete $CatFiles{"/"}; + genInfoIndex q{/}; + delete $CatFiles{q{/}}; } sub up { my $p = dirname noindex shift; - if (($p eq ".") or ($p eq "/")) { - return "Top"; + if (($p eq q{.}) || ($p eq q{/})) { + return q{Top}; } - return (nodename $p) . "/"; + return (nodename $p) . q{/}; } foreach my $cat (keys %CatFiles) { next if (exists $Mtimes{"${cat}index"}); print "${sep}File: self, Node: " . (nodename $cat) . - ", Up: " . (up $cat) . "\n\n"; + q{, Up: } . (up $cat) . "\n\n"; genInfoIndex $cat; } foreach my $page (keys %Mtimes) { print "${sep}File: self, Node: " . (nodename noindex $page) . - ", Up: " . (up $page) . "\n\n"; + q{, Up: } . (up $page) . "\n\n"; genInfo $page; } print "${sep}File: self, Node: index, Up: Top\n\n"; print "[index]\n* Menu:\n"; foreach my $cat (keys %CatFiles) { - print "* " . (nodename $cat) . ": " . + print q{* } . (nodename $cat) . q{: } . (nodename $cat) . ". (line 0)\n"; } foreach my $page (keys %Mtimes) { - print "* " . (nodename noindex $page) . ": " . + print q{* } . (nodename noindex $page) . q{: } . (nodename noindex $page) . ". (line 0)\n"; } print "${sep}Local Variables:\ncoding: utf-8\nEnd:\n"; -} elsif ($ARGV[0] eq "dot") { +} elsif ($ARGV[0] eq q{dot}) { print "digraph d {\n"; print "rankdir=LR\n"; print "node[shape=rectangle]\n";