use strict;
use warnings;
+use utf8;
+use Encode qw(encode decode);
+binmode STDOUT, ":encoding(UTF-8)";
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 >png
-By default ZK_DO_LINKS=1 and ZK_DO_BACKS=1 are set.
+By default ZK_DO_BACKS=1 is set.
Do not forget about .zkignore with regular expressions.
";
exit 1;
usage if $#ARGV == -1;
-my $doLinks = ((not exists $ENV{ZK_DO_LINKS}) or
- ($ENV{ZK_DO_LINKS} eq "1")) ? 1 : 0;
-my $doBacks = ((not exists $ENV{ZK_DO_BACKS}) or
+my $DoBacks = ((not exists $ENV{ZK_DO_BACKS}) or
($ENV{ZK_DO_BACKS} eq "1")) ? 1 : 0;
-my %mtimes;
-my %sizes;
-my %cats;
+my %Mtimes;
+my %Lines;
+my %CatFiles;
+my %CatDirs;
+
+sub noindex {
+ $_ = shift;
+ /(.*\/)index$/;
+ return (defined $1) ? $1 : $_;
+}
{
my @ignores;
if (-e ".zkignore") {
- open my $fh, "<", ".zkignore" or die "$!";
+ open my $fh, "<:encoding(UTF-8)", ".zkignore" or die "$!";
while (<$fh>) {
chop;
push @ignores, $_;
}
use File::Find;
use POSIX qw(strftime);
+ my $pth;
sub wanted {
my $fn = $_;
return if ($fn =~ /^\./) and ($fn ne ".");
- my $pth = $File::Find::name;
+ $pth = $File::Find::name;
+ $pth = decode "UTF-8", $pth;
$pth =~ s/^\.\/?//;
if (-d $fn) {
return if isignored "$pth/";
opendir(my $dh, $fn) or die "$!";
- my @entries;
- while (readdir $dh) {
+ my @_files;
+ my @_dirs;
+ while (readdir $dh) {;
next if /^\./;
+ $_ = decode "UTF-8", $_;
if (-d "$fn/$_") {
- $_ .= "/";
+ next if isignored(($fn eq ".") ? $_ : "$fn/$_/");
+ $_ = "$pth/$_/";
+ s/^\///;
+ push @_dirs, $_;
+ } else {
+ next if isignored(($fn eq ".") ? $_ : "$fn/$_");
+ $_ = "$pth/$_";
+ s/^\///;
+ push @_files, $_;
}
- next if isignored(($fn eq ".") ? $_ : "$fn/$_");
- push @entries, $_;
}
closedir $dh;
- $cats{$pth} = \@entries;
+ $CatFiles{"$pth/"} = \@_files;
+ $CatDirs{"$pth/"} = \@_dirs;
} else {
return if isignored $pth;
my @s = stat($fn) or die "$!";
- $sizes{$pth} = $s[7];
- $mtimes{$pth} = strftime "%Y-%m-%d %H:%M:%S", gmtime $s[9];
+ $Mtimes{$pth} = strftime "%Y-%m-%d %H:%M:%S", gmtime $s[9];
}
}
my %opts = (wanted => \&wanted, follow => 1);
find(\%opts, ".");
}
-sub indexless {
- $_ = shift;
- /(.*\/)index$/;
- return (defined $1) ? $1 : $_;
-}
-
-my %links;
-my %backs;
-for my $pth (keys %mtimes) {
+my %Links;
+my %Backs;
+for my $pth (keys %Mtimes) {
my %found;
+ my $lines = 0;
my sub procline;
sub procline {
if (/^include \[(.*)\]\r$/) {
- open(my $fh, "<", $1) or die "$!";
- while (<$fh>) { procline $_ }
+ $found{$1} = 1;
+ open(my $fh, "<:encoding(UTF-8)", $1) or die "$!";
+ while (<$fh>) { $lines++; procline $_ }
close $fh;
return;
}
next unless $w =~ /\[([^]]+)\]/;
$w = $1;
if ($w =~ /\/$/) {
- my $w = substr $w, 0, -1;
- if (not exists $cats{$w}) {
+ if (not exists $CatDirs{$w}) {
print "missing $w\n" if exists $ENV{ZK_PRINT_MISSING};
return;
}
} else {
- if (not exists $mtimes{$w}) {
+ if (not exists $Mtimes{$w}) {
print "missing $w\n" if exists $ENV{ZK_PRINT_MISSING};
return;
}
$found{$w} = 1;
}
}
- open(my $fh, "<", $pth) or die "$!";
- while (<$fh>) { procline $_ }
+ open(my $fh, "<:encoding(UTF-8)", $pth) or die "$!";
+ while (<$fh>) { $lines++; procline $_ }
close $fh;
+ $Lines{$pth} = $lines;
my @ws = sort keys %found;
next if $#ws == -1;
- $links{indexless $pth} = \@ws;
+ $pth = noindex $pth;
+ $Links{$pth} = \@ws;
foreach (@ws) {
- if (not exists $backs{$_}) {
+ if (not exists $Backs{$_}) {
my %h;
- $backs{$_} = \%h;
+ $Backs{$_} = \%h;
}
- $backs{$_}{$pth} = 1;
+ $Backs{$_}{$pth} = 1;
}
}
-sub startHead {
+sub genIndex {
my $out = shift;
- my $title = shift;
- print $out "<!DOCTYPE html>
-<html><head>
-<title>$title</title>
-<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">
-";
+ my $page = shift;
+ my $ctr = 0;
+ my $pth;
+ print $out " Links:\n";
+ foreach (sort @{$CatFiles{$page}}) {
+ printf $out "%3d % -39s %s %8d\n", $ctr, "[$_]", $Mtimes{$_}, $Lines{$_};
+ $ctr++;
+ }
+ my @links = sort @{$CatDirs{$page}};
+ if ($#links != -1) {
+ print $out "\n Subcategories:\n";
+ $ctr = 0;
+ my @entries;
+ my $count;
+ foreach (@links) {
+ @entries = @{$CatFiles{$_}};
+ $count = 1 + $#entries;
+ @entries = @{$CatDirs{$_}};
+ $count += 1 + $#entries;
+ printf $out "%3d % -64s %3d\n", $ctr, "[$_]", $count;
+ $ctr++;
+ }
+ }
+ print $out "do-backs\r\n";
}
sub htmlescape {
sub genHTML {
my $out = shift;
my $page = shift;
- my @lnks = exists $links{indexless $page} ? @{$links{indexless $page}} : ();
+ my $buf = shift;
+ my $doBacks = $DoBacks;
+ my $doAlt = 1;
+ my @links = ();
+ if ($page =~ /\/$/) {
+ @links = (@{$CatFiles{$page}}, @{$CatDirs{$page}});
+ $doBacks = 0;
+ $doAlt = 0;
+ } elsif (exists $Links{noindex $page}) {
+ @links = @{$Links{noindex $page}};
+ }
my @rels;
- {
+ my sub makerels {
+ @rels = ();
my $rel;
- foreach (@lnks) {
- $rel = File::Spec->abs2rel($_, $page);
- $rel = (length $rel > 2) ? (substr $rel, 3) : "";
+ foreach (@links) {
+ $rel = ($page eq "/") ? "$_" : File::Spec->abs2rel($_, $page);
+ if (not $page =~ /\/$/) {
+ $rel = (length $rel > 2) ? (substr $rel, 3) : "";
+ }
if (-d $_) {
- if ($rel ne "") {
+ unless ($rel =~ /\/$/) {
$rel .= "/";
}
$rel .= "index";
push @rels, $rel;
}
}
- startHead $out, indexless $page;
+ makerels;
{
+ my $title = noindex $page;
my $fn = basename $page;
- print $out "<link rel=\"alternate\" type=\"text/plain\" title=\"src\" href=\"$fn.txt\" />\n";
+ print $out "<!DOCTYPE html>
+<html><head>
+<title>$title</title>
+<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\">";
+ if ($doAlt) {
+ print $out "\n<link rel=\"alternate\" type=\"text/plain\" title=\"src\" href=\"$fn.txt\" />";
+ }
+ print $out "\n</head>\n<body>\n<pre>";
}
- print $out "</head>\n<body>\n<pre>";
- my $doLinksForced = 0;
- my $doBacksForced = 0;
my sub procline;
sub procline {
$_ = $_[0];
} else {
$_ = "<img src=\"$cols[1]\" />";
}
- } elsif ($cols[0] eq "do-links") {
- $doLinksForced = 1;
- return;
} elsif ($cols[0] eq "do-backs") {
- $doBacksForced = 1;
+ $doBacks = 1;
return;
} elsif ($cols[0] eq "raw") {
$_ = join " ", @cols[1..$#cols];
} elsif ($cols[0] eq "#") {
return;
} elsif ($cols[0] eq "include") {
- open(my $fh, "<", substr $cols[1], 1, -1) or die "$!";
+ open(my $fh, "<:encoding(UTF-8)", substr $cols[1], 1, -1) or die "$!";
while (<$fh>) { procline $_ }
close $fh;
return;
} else {
$_ = htmlescape $_;
if (/\[.+\]/) {
- while (my ($i, $l) = each @lnks) {
+ while (my ($i, $l) = each @links) {
s/\[\Q$l\E\]/<a href="$rels[$i].html">[$l]<\/a>/g;
}
}
}
print $out "$_\n";
}
- open(my $fh, "<", $page) or die "$!";
- while (<$fh>) { procline $_ }
- close $fh;
- print $out "</pre>\n";
- if ($doLinksForced or ($doLinks and $#lnks != -1)) {
- print $out "<a id=\"links\"></a><table border=1><caption>Links</caption>\n";
- my $mtime;
- while (my ($i, $l) = each @lnks) {
- $mtime = (exists $mtimes{$l}) ? $mtimes{$l} : "";
- print $out "<tr><td><a href=\"$rels[$i].html\">$l</a></td>
- <td><tt>$mtime</tt></td></tr>\n";
+ {
+ my $fh;
+ if (defined $buf) {
+ open($fh, "<:encoding(UTF-8)", \$buf) or die "$!";
+ } else {
+ open($fh, "<:encoding(UTF-8)", $page) or die "$!";
}
- print $out "</table>\n";
+ while (<$fh>) { procline $_ }
+ close $fh;
}
- @lnks = sort keys %{$backs{indexless $page}};
- my $backsWasGenerated = ($doBacksForced or ($doBacks and $#lnks != -1)) ? 1 : 0;
- if ($backsWasGenerated) {
- print $out "<a id=\"backs\"></a><table border=1><caption>Backlinks</caption>\n";
- my $rel;
- foreach my $l (@lnks) {
- $rel = File::Spec->abs2rel($l, $page);
- $rel = substr $rel, 3;
- print $out "<tr><td><a href=\"$rel.html\">$l</a></td>
- <td><tt>$mtimes{$l}</tt></td></tr>\n";
+ @links = sort keys %{$Backs{noindex $page}};
+ my $backsWereGenerated = ($doBacks and $#links != -1) ? 1 : 0;
+ if ($backsWereGenerated) {
+ makerels;
+ print $out "\n 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));
+ $ctr++;
}
- print $out "</table>\n";
}
+ print $out "</pre>\n";
print $out "</body></html>\n";
- return $backsWasGenerated;
+ return $backsWereGenerated;
}
-sub genIndex {
- my $out = shift;
- my $page = shift;
- startHead $out, "$page/";
- print $out "</head>\n<body>\n<table border=1>\n";
- my @lnks = sort @{$cats{$page}};
- foreach my $l (@lnks) {
- next if $l =~ /\/$/;
- my $pth = ($page eq "") ? $l : "$page/$l";
- print $out "<tr><td><a href=\"$l.html\">$pth</a></td>
- <td><tt>$mtimes{$pth}</tt></td><td>$sizes{$pth} B</td></tr>\n";
- }
- print $out "</table>\n";
- @lnks = grep { /\/$/ } @lnks;
- if ($#lnks != -1) {
- print $out "<a id=\"cats\"></a><table border=1><caption>Subcategories</caption>\n";
- foreach my $l (@lnks) {
- $l = substr $l, 0, -1;
- my $pth = ($page eq "") ? $l : "$page/$l";
- my @entries = @{$cats{$pth}};
- my $ctr = 1 + $#entries;
- print $out "<tr><td><a href=\"$l/index.html\">$pth</a></td>
- <td>$ctr</td></tr>\n"
- }
- print $out "</table>\n";
- }
- @lnks = sort keys %{$backs{"$page/"}};
- if ($#lnks != -1) {
- print $out "<a id=\"backs\"></a><table border=1><caption>Backlinks</caption>\n";
- my $rel;
- foreach my $l (@lnks) {
- $rel = File::Spec->abs2rel($l, $page);
- print $out "<tr><td><a href=\"$rel.html\">$l</a></td>
- <td><tt>$mtimes{$l}</tt></td><td>$sizes{$l} B</td></tr>\n";
- }
- print $out "</table>\n";
- }
- print $out "</body></html>\n"
+sub genIndex2Buf {
+ my $p = shift;
+ my $buf = "";
+ open(my $fh, ">:encoding(UTF-8)", \$buf) or die "$!";
+ genIndex $fh, $p;
+ close $fh;
+ return $buf;
}
if ($ARGV[0] eq "dump") {
use Data::Dumper;
- print Data::Dumper->Dump([\%links, \%backs, \%cats], [qw(*links *backs *cats)]);
+ print Data::Dumper->Dump([
+ \%Links,
+ \%Backs,
+ \%CatFiles,
+ \%CatDirs,
+ \%Mtimes,
+ \%Lines,
+ ],
+ [qw(*Links *Backs *CatFiles *CatDirs *Mtimes *Lines)]);
} elsif ($ARGV[0] eq "links") {
- map { print "$_\n" } @{$links{$ARGV[1]}};
+ my $p = decode "UTF-8", $ARGV[1];
+ map { print "$_\n" } @{$Links{$p}};
} elsif ($ARGV[0] eq "backs") {
- map { print "$_\n" } sort keys %{$backs{$ARGV[1]}};
-} elsif ($ARGV[0] eq "html") {
- genHTML \*STDOUT, $ARGV[1];
-} elsif ($ARGV[0] eq "html-index") {
- genIndex \*STDOUT, $ARGV[1];
+ 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;
+ foreach (sort keys %CatFiles) {
+ next unless /^$p/;
+ next if $_ eq "";
+ print "$_\n";
+ }
+} elsif ($ARGV[0] eq "gen-index") {
+ my $p = decode "UTF-8", $ARGV[1];
+ genIndex \*STDOUT, $p;
+} elsif ($ARGV[0] eq "gen-html") {
+ my $p = decode "UTF-8", $ARGV[1];
+ if ($p =~ /\/$/) {
+ genHTML \*STDOUT, $p, genIndex2Buf $p;
+ } else {
+ genHTML \*STDOUT, $p;
+ }
} elsif ($ARGV[0] eq "htmls") {
my $now = time;
use File::Path qw(make_path);
use File::Copy;
- foreach my $cat (keys %cats) {
+ foreach my $cat (keys %CatFiles) {
make_path "$ARGV[1]/$cat";
- next if (exists $mtimes{"$cat/index"});
- my $fn = "$ARGV[1]/$cat/index.html";
- open(my $fh, ">", $fn) or die "$!";
- genIndex $fh, $cat;
+ next if (exists $Mtimes{"${cat}index"});
+ my $fn = "$ARGV[1]/${cat}index.html";
+ open(my $fh, ">:encoding(UTF-8)", $fn) or die "$!";
+ genHTML $fh, $cat, genIndex2Buf $cat;
close $fh;
utime $now, $now, $fn;
}
- foreach my $pth (keys %mtimes) {
- open(my $fh, ">", "$ARGV[1]/$pth.html") or die "$!";
- my $backsWasGenerated = genHTML $fh, $pth;
+ foreach my $pth (keys %Mtimes) {
+ open(my $fh, ">:encoding(UTF-8)", "$ARGV[1]/$pth.html") or die "$!";
+ my $backsWereGenerated = genHTML $fh, $pth;
close $fh;
my @s = stat($pth) or die "$!";
- if ($backsWasGenerated) {
+ if ($backsWereGenerated) {
utime $now, $now, "$ARGV[1]/$pth.html";
} else {
utime $s[9], $s[9], "$ARGV[1]/$pth.html";
print "digraph d {\n";
print "rankdir=LR\n";
print "node[shape=rectangle]\n";
- while (my ($from, $v) = each %links) {
+ while (my ($from, $v) = each %Links) {
foreach (@{$v}) {
print "\t\"$from\" -> \"$_\"\n";
}