perl/modules/W3C/LinkChecker/bin checklink,4.179,4.180

Update of /sources/public/perl/modules/W3C/LinkChecker/bin
In directory hutz:/tmp/cvs-serv14435/bin

Modified Files:
	checklink 
Log Message:
Look for an index file if passed a dir, prefer it if found over dir contents.


Index: checklink
===================================================================
RCS file: /sources/public/perl/modules/W3C/LinkChecker/bin/checklink,v
retrieving revision 4.179
retrieving revision 4.180
diff -u -d -r4.179 -r4.180
--- checklink	4 Feb 2010 19:15:47 -0000	4.179
+++ checklink	21 Feb 2010 16:57:43 -0000	4.180
@@ -910,8 +910,25 @@
 
 sub urize ($)
 {
-  my $u = URI->new_abs(URI::Escape::uri_unescape($_[0]), URI::file->cwd());
-  return $u->as_string();
+  my $arg = shift;
+  my $uarg = URI::Escape::uri_unescape($arg);
+  my $uri;
+  if (-d $uarg) {
+    # look for an "index" file in dir, return it if found
+    require File::Spec;
+    for my $index (map { File::Spec->catfile($uarg, $_) }
+                   qw(index.html index.xhtml index.htm index.xhtm)) {
+      if (-e $index) {
+        $uri = URI::file->new_abs($index);
+        last;
+      }
+    }
+    # return dir itself if an index file was not found
+    $uri ||= URI::file->new_abs($uarg);
+  } else {
+    $uri = URI->new_abs($arg, URI::file->cwd());
+  }
+  return $uri->as_string();
 }
 
 ########################################

Received on Sunday, 21 February 2010 16:57:48 UTC