2006/ack ack.pl,1.9,1.10 check.js,1.4,1.5

Update of /sources/public/2006/ack
In directory hutz:/tmp/cvs-serv9193

Modified Files:
	ack.pl check.js 
Log Message:
Improve initial URL sanity/error checking, output it in results.

Index: check.js
===================================================================
RCS file: /sources/public/2006/ack/check.js,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- check.js	25 May 2006 21:10:25 -0000	1.4
+++ check.js	25 May 2006 21:56:22 -0000	1.5
@@ -50,9 +50,10 @@
   var links = document.getElementsByTagName("a");
   TOTAL = links.length;
   updateCount(0);
-  for (var i = 0; i < links.length; i++) {
+  for (var i = 0; i < TOTAL; i++) {
     check(links.item(i));
   }
+  if (TOTAL == 0) finishCheck();
 }
 
 function pauseResume(el)
@@ -93,6 +94,14 @@
   }
 }
 
+function finishCheck()
+{
+  var pr = el("pr");
+  pr.value = "Completed";
+  pr.paused = false;
+  pr.disabled = true;
+}
+
 function check(link)
 {
   if (link.id == null || link.id == "" || link.checking) return;
@@ -184,11 +193,6 @@
     link.done = true;
     link.checking = false;
     updateCount(1);
-    if (DONE >= TOTAL) {
-      var pr = el("pr");
-      pr.value = "Completed";
-      pr.paused = false;
-      pr.disabled = true;
-    }
+    if (DONE >= TOTAL) finishCheck();
   }
 }

Index: ack.pl
===================================================================
RCS file: /sources/public/2006/ack/ack.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- ack.pl	25 May 2006 21:10:25 -0000	1.9
+++ ack.pl	25 May 2006 21:56:21 -0000	1.10
@@ -26,19 +26,30 @@
 use LWP::UserAgent ();
 use URI ();
 
-use constant ML => 60;
+use constant MAXLEN => 60;
 
-my $url = CGI->new()->param("url") || "";
+(my $url = CGI->new()->param("url") || "") =~ s/^\s*\/*(.*?)\s*//;
 my %links;
 
+my $success = !$url;
+my $status = "";
+
 if ($url) {
     my $file = File::Temp->new();
 
+    $url = URI->new($url);
+    $url = "http://" . $url unless $url->scheme();
+
     my $res = LWP::UserAgent->new(
         protocols_allowed => [qw(http https ftp data)]
         )->get($url, ":content_file" => "$file");
     $url = $res->request()->uri()->canonical();
 
+    $success = $res->is_success();
+    $status = $res->status_line();
+
+    goto OUTPUT unless $success;
+
     my $base = $res->base();
 
     my @extra_links;
@@ -80,22 +91,26 @@
     }
 }
 
+OUTPUT:
+
+my $eurl = encode_entities($url || "");
+my $title = ($eurl ? "ACK! - $eurl" : "ACK!");
+
 print "Content-Type: text/html; charset=UTF-8\n\n";
 print "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
 <html>
 <head>
-<title>ACK!</title>
+<title>$title</title>
 <link rel=\"stylesheet\" type=\"text/css\" href=\"ack.css\" />
 <script type=\"text/javascript\" src=\"check.js\"></script>
 </head>
-<body", $url ? " onload=\"checkAll()\"" : "", ">
+<body", ($url ? " onload=\"checkAll()\"" : ""), ">
 
-<h2>ACK!</h2>
+<h2>$title</h2>
 
 <form action=\"?\" method=\"get\">
 <p>
-<input id=\"url\" name=\"url\" type=\"text\" size=\"60\" value=\"", encode_entities($url),
-  "\" />
+<input id=\"url\" name=\"url\" type=\"text\" size=\"60\" value=\"$eurl\" />
 <input name=\"go\" type=\"submit\" value=\"Check links\" />
 <input id=\"pr\" type=\"button\" onclick=\"pauseResume(this)\" value=\"Pause\" disabled=\"disabled\" />
 <span id=\"stat\">(0 of 0 checked)</span>
@@ -117,13 +132,20 @@
     my $md5 = md5_hex($_);
     my $url = encode_entities($_);
     my $l = length($_);
-    my $foo = encode_entities($l > ML ?
-      substr($_, 0, ML/2) . "[...]" . substr($_, $l - ML/2) : $_);
+    my $foo = encode_entities($l > MAXLEN ?
+      substr($_, 0, MAXLEN/2) . "[...]" . substr($_, $l - MAXLEN/2) : $_);
     print "<tr><td><a id=\"L$md5\" href=\"$url\" onclick=\"check(this);return false\">$foo</a>";
     print "&nbsp;($links{$_})" if ($links{$_} > 1);
     print "</td><td class=\"na\" id=\"S$md5\">uninitialized</td></tr>\n";
   }
   print "</tbody>\n</table>\n";
 }
+elsif (!$success) {
+  printf "<p>Error: <span class=\"error\">%s</span></p>\n",
+    encode_entities($status || "unknown error");
+}
+elsif ($url) {
+  print "<p>No links found.</p>\n";
+}
 
 print "</body>\n</html>";

Received on Thursday, 25 May 2006 21:56:30 UTC