List:Commits« Previous MessageNext Message »
From:mcbrown Date:December 1 2006 1:03pm
Subject:svn commit - mysqldoc@docsrva: r4091 - in trunk: make.d tools
View as plain text  
Author: mcbrown
Date: 2006-12-01 14:03:18 +0100 (Fri, 01 Dec 2006)
New Revision: 4091

Log:
Updated deep-check.pl so that it now checks <ulink> URLs by attempting to downloading the header of the corresponding URL. Reports an error if the link no longer leads anywhere, or in the event of some other failure. 

To run manually, use: deep-check.pl --checkulinks file.xml

Or, use the new make target: 

make file.ulinkcheck

Minor updates to idremap to allow ID mapping in a branch directory




Modified:
   trunk/make.d/xml-valid
   trunk/tools/deep-check.pl
   trunk/tools/idremap.pl


Modified: trunk/make.d/xml-valid
===================================================================
--- trunk/make.d/xml-valid	2006-12-01 10:02:39 UTC (rev 4090)
+++ trunk/make.d/xml-valid	2006-12-01 13:03:18 UTC (rev 4091)
Changed blocks: 2, Lines Added: 4, Lines Deleted: 0; 835 bytes

@@ -26,6 +26,9 @@
 %.deepcheck: %-prepped.xml
 	$(DEEP_CHECK) $<
 
+%.ulinkcheck: %-prepped.xml
+	$(DEEP_CHECK) --checkulink $<
+
 ifdef IDMAP_REFS
 
 # None of the following rules are defined at all unless id-mapping

@@ -70,6 +73,7 @@
 	@echo "make idmap.reconcile      - reconcile ID maps for the current directory"
 	@echo "make idmap.reconcile.refs - reconcile ID maps for all directories referenced by main document"
 	@echo "make file.deepcheck       - perform deep check of file.xml"
+	@echo "make file.ulinkcheck      - checks <ulink> URLs for file.xml"
 else
 help::
 	@echo "make file.valid           - validate file.xml"


Modified: trunk/tools/deep-check.pl
===================================================================
--- trunk/tools/deep-check.pl	2006-12-01 10:02:39 UTC (rev 4090)
+++ trunk/tools/deep-check.pl	2006-12-01 13:03:18 UTC (rev 4091)
Changed blocks: 17, Lines Added: 111, Lines Deleted: 28; 12202 bytes

@@ -14,6 +14,7 @@
 #   Set max line length with --linelength (default: 72)
 # - Checks for empty <link> references
 # - Checks for <Table> and <informaltable> definitions
+# - Checks external (ulinks) if you ask with checkulink
 
 # Martin MC Brown
 # mc@stripped

@@ -25,10 +26,12 @@
 my ($checkwidth,
     $linelength,
     $checkimages,
-    $help) = (0,72,0,0);
+    $checkulink,
+    $help) = (0,72,0,0,0);
 
 GetOptions("checkwidth" => \$checkwidth,
            "checkimages" => \$checkimages,
+           "checkulink" => \$checkulink,
            "linelength=i" => \$linelength,
            "help" => \$help,
            );

@@ -36,13 +39,16 @@
 if ($help)
 {
     print <<EOF;
-deep-check.pl [--checkwidth] [--checkimages] [--linelength=#] file.xml
+deep-check.pl [--checkulink] [--checkwidth] [--checkimages] [--linelength=#] file.xml
 
 Where:
  --checkwidth:    Enables width checking of <progralisting> elements 
                   (default length is 72 characters)
  --checkimages:   Compares images in the current images directory
                   With those found in the XML and reports differences
+ --checkulink:    Checks external URLs for validity (must have net
+                  connection). 
+                  ***Supercedes all checks - No other items are checked***
  --linelength=#:  Sets the maximum line length (when --checkwidth 
                   enabled)
 EOF

@@ -83,6 +89,27 @@
 EOF
 }
 
+if ($checkulink)
+{
+    print STDERR "\nWarning: Checking for external links may take some time. Please be patient\n";
+
+    eval "require LWP::UserAgent;";
+
+    if ($@)
+    {
+        die <<EOF;
+To check external links (<ulink> tags), you must have the 
+LWP::UserAgent Perl module installed. 
+
+To install, run:
+
+\$ perl -MCPAN -e 'install LWP::UserAgent'
+
+EOF
+
+}
+}
+
 my $file = shift or die "You must supply the name of the file to process";
 
 my $known_imgs = {};

@@ -93,7 +120,9 @@
 }
 
 my $my_handler = MySQLDocBook->new({checkwidth => $checkwidth,
-                                linelength => $linelength});
+                                    linelength => $linelength,
+                                    checkulink => $checkulink,
+                                });
 
 XML::Parser::PerlSAX->new->parse(Source => { SystemId => $file}, 
                                  Handler => $my_handler);

@@ -109,8 +138,14 @@
     }
 }
 
+if ($my_handler->{errorcount} > 0)
+{
+    print STDERR ("\nErrors in document: $my_handler->{errorcount}\n");
+}
+
 package MySQLDocBook;
 use File::Basename;
+use LWP::UserAgent;
 
 sub new
 {

@@ -118,9 +153,9 @@
     my $class = ref($self) || $self;
     my $options = shift;
 
-
     return bless {'options' => $options,
                   'sectionids' => {},
+                  'triedulinks' => {},
                   'currsection' => '',
                   'sectionmap' => [],
                   'intag' => 0,

@@ -131,15 +166,54 @@
                   'linkref' => '',
                   'linktext' => '',
                   'intable' => 0,
+                  'errorcount' => 0,
                   'checklinelength' => 0,
                   'loc' => [],
               }, $class;
 }
 
+sub print_error
+{
+    my ($self,@params) = @_;
+
+    print "\n" if ($self->{errorcount} == 0);
+    $self->{errorcount}++;
+
+    print STDERR (@params);
+}
+
+sub printf_error
+{
+    my ($self,$format,@params) = @_;
+
+    $self->print_error(sprintf($format,@params));
+}
+
 sub start_element
 {
     my ($self, $element) = @_;
 
+    if ($self->{options}->{checkulink} && $element->{Name} eq 'ulink')
+    {
+        if (!exists($self->{triedulinks}->{$element->{Attributes}->{'url'}}))
+        {
+            $self->{triedulinks}->{$element->{Attributes}->{'url'}} = 1;
+            my $ua = LWP::UserAgent->new;
+
+            my $response = $ua->head($element->{Attributes}->{url});
+
+            if ($response->is_error())
+            {
+                $self->print_error("Error URL link to ",
+                              $element->{Attributes}->{url},
+                              " fails with ", 
+                              $response->status_line,
+                              "\n");
+            }
+        }
+        return;
+    }
+
     if ($element->{Name} =~ m/^(chapter|section|appendix)$/)
     {
         if (exists($element->{Attributes}->{'xml:base'}))

@@ -163,7 +237,7 @@
                               $element->{Attributes}->{fileref});
         if (!-e $realref)
         {
-            print STDERR "Error image: $realref does not exist\n";
+            $self->print_error("Error image: $realref does not exist\n");
         }
     }
 

@@ -182,7 +256,7 @@
         }
         else 
         {
-            print STDERR "Error: Cannot have a <$element->{Name}> without linkend attribute\n";
+            $self->print_error("Error: Cannot have a <$element->{Name}> without linkend attribute\n");
         }
     }
 

@@ -194,7 +268,7 @@
             $self->{currsection} = $element->{Attributes}->{id};
             if (exists($self->{sectionids}->{$element->{Attributes}->{id}}))
             {
-                print STDERR "Error: Found a duplicate reference ID ($element->{Attributes}->{id})\n";
+                $self->print_error("Error: Found a duplicate reference ID ($element->{Attributes}->{id})\n");
             }
             else
             {

@@ -204,7 +278,7 @@
         }
         else
         {
-            print STDERR "Error: Found a $element->{Name} without an ID!\n";
+            $self->print_error("Error: Found a $element->{Name} without an ID!\n");
         }
     }
 

@@ -252,6 +326,10 @@
 {
     my ($self, $element) = @_;
 
+    if ($self->{options}->{checkulink})
+    {
+        return;
+    }
     if ($element->{Name} eq 'section')
     {
         if (exists($element->{Attributes}->{id}))

@@ -271,13 +349,13 @@
     {
         if ($self->{linktext} !~ m/[a-zA-Z0-9]+/ && $element->{Name} eq 'link')
         {
-            print STDERR ("Error: You cannot use <link> to '",
-                          $self->{linkref} || 'NOLINK',
-                          "' without linking text\n");
+            $self->print_error("Error: You cannot use <link> to '",
+                               $self->{linkref} || 'NOLINK',
+                               "' without linking text\n");
         }
         if ($self->{linktext} =~ m/[a-zA-Z0-9]+/ && $element->{Name} eq 'xref')
         {
-            print STDERR ("Error: You cannot use <xref> to '",
+            $self->print_error("Error: You cannot use <xref> to '",
                           $self->{linkref} || 'NOLINK',
                           "' with linking text\n");
         }

@@ -303,59 +381,59 @@
 
         if (!defined($self->{tabledefs}->{$self->{tablecount}}->{speccolumns}))
         {
-            print STDERR ("Error in Table within section ",
+            $self->print_error("Error in Table within section ",
                           $self->{tabledefs}->{$self->{tablecount}}->{section} || 'UNKNOWN',
                           ": No columns specified in table!\n");
         }
         elsif (!defined($self->{tabledefs}->{$self->{tablecount}}->{defcolumns}))
         {
-            print STDERR ("Error in Table within section ",
+            $self->print_error("Error in Table within section ",
                           $self->{tabledefs}->{$self->{tablecount}}->{section} || 'UNKNOWN',
                           ": No columns in table!\n");
         }
         elsif ($self->{tabledefs}->{$self->{tablecount}}->{speccolumns} != 
                $self->{tabledefs}->{$self->{tablecount}}->{defcolumns})
         {
-            print STDERR "Error in Table within section $self->{tabledefs}->{$self->{tablecount}}->{section}\n";
-            print STDERR "\tWarning!: Column definition mismatch!!\n";
-            print STDERR "\tGroup defined columns (tgroup) $self->{tabledefs}->{$self->{tablecount}}->{defcolumns}\n";
-            print STDERR "\tSpecified columns (colspec) $self->{tabledefs}->{$self->{tablecount}}->{speccolumns}\n";
+            $self->print_error("Error in Table within section $self->{tabledefs}->{$self->{tablecount}}->{section}\n",
+                               "\tWarning!: Column definition mismatch!!\n",
+                               "\tGroup defined columns (tgroup) $self->{tabledefs}->{$self->{tablecount}}->{defcolumns}\n",
+                               "\tSpecified columns (colspec) $self->{tabledefs}->{$self->{tablecount}}->{speccolumns}\n");
         }
         elsif (($self->{tabledefs}->{$self->{tablecount}}->{speccolumns} != 
                $self->{tabledefs}->{$self->{tablecount}}->{maxcolumns}) ||
                ($self->{tabledefs}->{$self->{tablecount}}->{speccolumns} != 
                $self->{tabledefs}->{$self->{tablecount}}->{maxcolumns}))
         {
-            print STDERR "Error in Table within section $self->{tabledefs}->{$self->{tablecount}}->{section}\n";
-            print STDERR "\tWarning!: Column definition/column number mismatch!!\n";
-            print STDERR "\tGroup defined columns (tgroup) $self->{tabledefs}->{$self->{tablecount}}->{defcolumns}\n";
-            print STDERR "\tSpecified columns (colspec) $self->{tabledefs}->{$self->{tablecount}}->{speccolumns}\n";
-            print STDERR "\tActual columns (entry) $self->{tabledefs}->{$self->{tablecount}}->{maxcolumns}\n";
+            $self->print_error("Error in Table within section $self->{tabledefs}->{$self->{tablecount}}->{section}\n",
+                               "\tWarning!: Column definition/column number mismatch!!\n",
+                               "\tGroup defined columns (tgroup) $self->{tabledefs}->{$self->{tablecount}}->{defcolumns}\n",
+                               "\tSpecified columns (colspec) $self->{tabledefs}->{$self->{tablecount}}->{speccolumns}\n",
+                               "\tActual columns (entry) $self->{tabledefs}->{$self->{tablecount}}->{maxcolumns}\n");
         }
 
         # Check the column width count and ensure that the total figures equal 100
 
         if (!defined($self->{tabledefs}->{$self->{tablecount}}->{colwidth}))
         {
-            print STDERR ("Error in Table within section ",
+            $self->print_error("Error in Table within section ",
                           $self->{tabledefs}->{$self->{tablecount}}->{section} || 'UNKNOWN',
                           ": No column width specified\n");
         }
         elsif ($self->{tabledefs}->{$self->{tablecount}}->{colwidth} == 0)
         {
-            print STDERR ("Error in Table within section ",
+            $self->print_error("Error in Table within section ",
                           $self->{tabledefs}->{$self->{tablecount}}->{section} || 'UNKNOWN',
                           ": Total column width is 0\n");
         }
         elsif ($self->{tabledefs}->{$self->{tablecount}}->{colwidth} == 0)
         {
-            print STDERR ("Error in Table within section ",
+            $self->print_error("Error in Table within section ",
                           $self->{tabledefs}->{$self->{tablecount}}->{section} || 'UNKNOWN',
                           ": Total column width is less than 100%\n");
         }
         elsif ($self->{tabledefs}->{$self->{tablecount}}->{colwidth} > 100)
         {
-            print STDERR ("Error in Table within section ",
+            $self->print_error("Error in Table within section ",
                           $self->{tabledefs}->{$self->{tablecount}}->{section} || 'UNKNOWN',
                           ": Total column width is more than 100%\n");
         }

@@ -368,6 +446,11 @@
 {
     my ($self, $element) = @_;
 
+    if ($self->{options}->{checkulink})
+    {
+        return;
+    }
+
     if ($self->{inlink} == 1)
     {
         $self->{linktext} .= $element->{Data};

@@ -379,7 +462,7 @@
         my @lines = split /[\r\n]+/,$element->{Data};
         foreach my $line (@lines)
         {
-            printf STDERR ("Following line is more than $self->{options}->{linelength} characters long\n%s\n\n",$line) 
+            $self->printf_error("Following line is more than $self->{options}->{linelength} characters long\n%s\n\n",$line) 
                 if (length($line) > $self->{options}->{linelength});
         }
     }


Modified: trunk/tools/idremap.pl
===================================================================
--- trunk/tools/idremap.pl	2006-12-01 10:02:39 UTC (rev 4090)
+++ trunk/tools/idremap.pl	2006-12-01 13:03:18 UTC (rev 4091)
Changed blocks: 1, Lines Added: 1, Lines Deleted: 1; 398 bytes

@@ -8,7 +8,7 @@
 # 2006-08-17
 
 use strict;
-use lib qw(../tools ../../tools);
+use lib qw(../tools ../../tools ../../../trunk/tools);
 use IDMap;
 use Data::Dumper;
 use Getopt::Long;


Thread
svn commit - mysqldoc@docsrva: r4091 - in trunk: make.d toolsmcbrown1 Dec