]> Sergey Matveev's repositories - zk.git/commitdiff
URLise links
authorSergey Matveev <stargrave@stargrave.org>
Wed, 7 May 2025 13:43:51 +0000 (16:43 +0300)
committerSergey Matveev <stargrave@stargrave.org>
Wed, 7 May 2025 13:43:51 +0000 (16:43 +0300)
zk

diff --git a/zk b/zk
index 8b2a8d750fdc561d386cea15df0f19fb372db4a5..a65ff5c40e2a711afbe3fcdd930c260a632d61c6 100755 (executable)
--- a/zk
+++ b/zk
@@ -179,6 +179,20 @@ sub startBody {
 </head><body>";
 }
 
+
+my %schemes = (
+    "finger" => 1,
+    "ftp" => 1,
+    "gemini" => 1,
+    "gopher" => 1,
+    "http" => 1,
+    "https" => 1,
+    "irc" => 1,
+    "ircs" => 1,
+    "news" => 1,
+    "telnet" => 1,
+);
+
 use File::Spec;
 
 sub genHTML {
@@ -186,27 +200,47 @@ sub genHTML {
     my $page = shift;
     my @lnks = defined $links{$page} ? @{$links{$page}} : ();
     my @rels;
-    my $rel;
-    foreach (@lnks) {
-        $rel = File::Spec->abs2rel($_, $page);
-        $rel = substr $rel, 3;
-        if (-d $rel) {
-            $rel .= "/index";
+    {
+        my $rel;
+        foreach (@lnks) {
+            $rel = File::Spec->abs2rel($_, $page);
+            $rel = substr $rel, 3;
+            if (-d $rel) {
+                $rel .= "/index";
+            }
+            push @rels, $rel;
         }
-        push @rels, $rel;
     }
     startBody $out, $page;
     print $out "<pre>\n";
     open(my $fh, "<", $page) or die "$!";
     while (<$fh>) {
-        s/&/\&amp;/g;
-        s/</\&lt;/g;
-        s/>/\&gt;/g;
-        my $rel;
-        while (my ($i, $l) = each @lnks) {
-            s/\[$l\]/<a href="$rels[$i].html">[$l]<\/a>/g;
+        my @ws;
+        chop;
+        /( *)$/;
+        my $tail = $1;
+        foreach my $w (split / /) {
+            my ($scheme, $authority, $path, $query, $fragment) = $w =~
+                m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
+            if (defined $scheme and exists $schemes{$scheme}) {
+                my $e = $w;
+                $e =~ s/&/\&amp;/g;
+                $w = "<a href=\"$w\">$e</a>";
+            } else {
+                if ($w =~ m/^\[.+\]$/) {
+                    while (my ($i, $l) = each @lnks) {
+                        $w =~ s/\[$l\]/<a href="$rels[$i].html">[$l]<\/a>/g;
+                    }
+                } else {
+                    $w =~ s/&/\&amp;/g;
+                    $w =~ s/</\&lt;/g;
+                    $w =~ s/>/\&gt;/g;
+                }
+            }
+            push @ws, $w;
         }
-        print $out $_;
+        my $w = join " ", @ws;
+        print $out "${w}${tail}\n";
     }
     close $fh;
     print $out "</pre>\n";
@@ -223,6 +257,7 @@ sub genHTML {
     @lnks = sort keys %{$backs{$page}};
     if ($#lnks != -1) {
         print $out "<table border=1><caption>Backlinks</caption>\n";
+        my $rel;
         foreach my $l (@lnks) {
             $rel = File::Spec->abs2rel($l, $page);
             $rel = substr $rel, 3;