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;
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;
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;
my $lines = 0;
my sub procline;
sub procline {
- if (/^<<.*\[(.*)\]\r$/) {
+ 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;
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;
$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\r\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;
}
@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 "<!DOCTYPE html>
+ my $fn = ($page =~ /\/$/) ? q{index} : basename $page;
+ print {$out} <<"END_HTML"
+<!DOCTYPE html>
<html><head>
<title>$title</title>
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">
<link rel=\"alternate\" type=\"text/plain\" title=\"src\" href=\"$fn.txt\" />
</head>
<body>
-<pre>";
+<pre>
+END_HTML
}
- my $indent = "";
+ my $indent = q{};
my sub procline;
sub procline {
$_ = shift;
chop;
- if (/\r$/) {
+ 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=> <a href=\"$cols[1]\">$t</a>";
- } 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<img src=\"$cols[1]\" alt=\"$t\" />";
} else {
$_ = "$head<img src=\"$cols[1]\" />";
}
- } 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 $_;
}
}
}
- 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 "|<a id=\"backs\"><hr/>\r\n";
- print $out " Backlinks:\n";
+ procline "|<a id=\"backs\"><hr/>${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 "</pre>\n";
- print $out "</body></html>\n";
+ print {$out} "</pre>\n";
+ print {$out} "</body></html>\n";
return $backsWereGenerated;
}
}
sub printMenuEntry {
- print "* " . (nodename $_) . ": " . (nodename $_) . ".\n";
+ print q{* } . (nodename $_) . q{: } . (nodename $_) . ".\n";
+ return;
}
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 (/\r$/) {
+ 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";
}
print "\n";
}
+ return;
}
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,
\%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;
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\1f\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 "\0\b[index\0\b]\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";