W3C home > Mailing lists > Public > www-validator-cvs@w3.org > October 2009

validator/httpd/cgi-bin check,1.710,1.711

From: Ville Skytta via cvs-syncmail <cvsmail@w3.org>
Date: Mon, 05 Oct 2009 20:34:39 +0000
To: www-validator-cvs@w3.org
Message-Id: <E1MuuGV-0003D3-55@lionel-hutz.w3.org>
Update of /sources/public/validator/httpd/cgi-bin
In directory hutz:/tmp/cvs-serv12227

Modified Files:
	check 
Log Message:
Move subroutine definitions after main program flow.

Index: check
===================================================================
RCS file: /sources/public/validator/httpd/cgi-bin/check,v
retrieving revision 1.710
retrieving revision 1.711
diff -u -d -r1.710 -r1.711
--- check	5 Oct 2009 19:49:45 -0000	1.710
+++ check	5 Oct 2009 20:34:37 -0000	1.711
@@ -822,6 +822,151 @@
 }
 &abort_if_error_flagged($File, 0);
 
+#
+# Force "XML" if type is an XML type and an FPI was not found.
+# Otherwise set the type to be the FPI.
+if (&is_xml($File) and not $File->{DOCTYPE} and  lc($File->{Root}) ne 'html') {
+  $File->{Version} = 'XML';
+} else {
+  $File->{Version} ||= $File->{DOCTYPE};
+}
+
+#
+# Get the pretty text version of the FPI if a mapping exists.
+if (my $prettyver = $CFG->{Types}->{$File->{Version}}->{Display}) {
+  $File->{Version} = $prettyver;
+}
+
+#
+# check the received mime type against Allowed mime types
+if ($File->{ContentType}){
+  my @allowedMediaType =
+    split(/\s+/, $CFG->{Types}->{$File->{DOCTYPE}}->{Types}->{Allowed} || '');
+  my $usedCTisAllowed;
+  if (scalar @allowedMediaType)  {
+    $usedCTisAllowed = FALSE;
+    foreach (@allowedMediaType) { $usedCTisAllowed = TRUE if ($_ eq $File->{ContentType}); }
+  }
+  else {
+    # wedon't know what media type is recommended, so better shut up
+    $usedCTisAllowed = TRUE;
+  }
+  if(! $usedCTisAllowed ){
+    &add_warning('W23', {
+        W23_type => $File->{ContentType},
+        W23_type_pref => $CFG->{Types}->{$File->{DOCTYPE}}->{Types}->{Preferred},
+        w23_doctype => $File->{Version}
+    });
+  }
+}
+
+#
+# Warn about unknown, incorrect, or missing Namespaces.
+if ($File->{Namespace}) {
+  my $ns  = $CFG->{Types}->{$File->{Version}}->{Namespace} || FALSE;
+
+  if (&is_xml($File)) {
+    if ($ns eq $File->{Namespace}) {
+      &add_warning('W10', {
+        W10_ns   => $File->{Namespace},
+        W10_type => $File->{Type},
+      });
+    }
+  } else {
+    &add_warning('W11', {W11_ns => $File->{Namespace},
+    w11_doctype => $File->{DOCTYPE}});
+  }
+} else {
+  if (&is_xml($File) and $CFG->{Types}->{$File->{Version}}->{Namespace}) {
+    &add_warning('W12', {});
+  }
+}
+
+
+## if invalid content, AND if requested, pass through tidy
+if (!$File->{'Is Valid'} && $File->{Opt}->{'Show Tidy'}) {
+  eval {
+    local $SIG{__DIE__};
+    require HTML::Tidy;
+    my $tidy = HTML::Tidy->new({config_file => $CFG->{Paths}->{TidyConf}});
+    my $cleaned = $tidy->clean(join("\n", @{$File->{Content}}));
+    $cleaned = Encode::decode_utf8($cleaned);
+    $File->{Tidy} = $cleaned;
+  };
+  if ($@) {
+    (my $errmsg = $@) =~ s/ at .*//s;
+    &add_warning('W29', { W29_msg => $errmsg });
+  }
+}
+
+my $template;
+
+if ($File->{Opt}->{Output} eq 'xml') {
+  $template = $File->{Templates}->{XML};
+} elsif ($File->{Opt}->{Output} eq 'earl') {
+  $template = $File->{Templates}->{EARLXML};
+} elsif ($File->{Opt}->{Output} eq 'n3') {
+  $template = $File->{Templates}->{EARLN3};
+} elsif ($File->{Opt}->{Output} eq 'json') {
+  $template = $File->{Templates}->{JSON};
+} elsif ($File->{Opt}->{Output} eq 'ucn') {
+  $template = $File->{Templates}->{UCN};
+} elsif ($File->{Opt}->{Output} eq 'soap12') {
+  if ($CFG->{'Enable SOAP'} != 1) { # API disabled - ideally this should have been sent before performing validation...
+    print CGI::header(-status => 503, -content_language => "en",
+    -type => "text/html", -charset => "utf-8"
+    );
+    $template = $File->{Templates}->{SOAPDisabled};
+  } elsif ($File->{'Error Flagged'}) { # should send SOAP fault message
+    $template = $File->{Templates}->{SOAPFault};
+    # we fill the soap fault template
+    #with the variables that had been passed to the HTML fatal error template
+    foreach my $fault_param ($File->{Templates}->{Error}->param()) {
+      $template->param($fault_param => $File->{Templates}->{Error}->param($fault_param));
+    }
+  } else {
+    $template = $File->{Templates}->{SOAP};
+  }
+} else {
+  $template = $File->{Templates}->{Result};
+}
+
+&prep_template($File, $template);
+&fin_template($File, $template);
+
+$template->param(file_warnings => $File->{Warnings});
+$template->param(tidy_output => $File->{Tidy});
+$template->param(file_source => &source($File))
+  if ($template->param('opt_show_source') or ($File->{'Is Upload'}) or ($File->{'Direct Input'}));
+
+if ($File->{Opt}->{Output} eq 'json') {
+  # No JSON escaping in HTML::Template (and "JS" is not the right thing here)
+  my $json = JSON->new();
+  $json->allow_nonref(TRUE);
+  for my $msgs ($template->param("file_errors"),
+                $template->param("file_warnings")) {
+    next unless $msgs;
+    for my $msg (@$msgs) {
+      for my $key (qw(msg expl)) {
+        $msg->{$key} = $json->encode($msg->{$key}) if $msg->{$key};
+      }
+    }
+  }
+}
+
+# transcode output from perl's internal to utf-8 and output
+print Encode::encode('UTF-8', $template->output);
+
+#
+# Get rid of $File object and exit.
+undef $File;
+exit;
+
+
+#############################################################################
+# Subroutine definitions
+#############################################################################
+
 # TODO: need to bring in fixes from html5_validate() here
 sub compoundxml_validate (\$) {
   my $File = shift;
@@ -1088,6 +1233,7 @@
   return $File;
 }
 
+
 sub dtd_validate (\$) {
   my $File = shift;
   my $opensp = SGML::Parser::OpenSP->new();
@@ -1154,153 +1300,6 @@
   return $File;
 }
 
-
-
-
-#
-# Force "XML" if type is an XML type and an FPI was not found.
-# Otherwise set the type to be the FPI.
-if (&is_xml($File) and not $File->{DOCTYPE} and  lc($File->{Root}) ne 'html') {
-  $File->{Version} = 'XML';
-} else {
-  $File->{Version} ||= $File->{DOCTYPE};
-}
-
-#
-# Get the pretty text version of the FPI if a mapping exists.
-if (my $prettyver = $CFG->{Types}->{$File->{Version}}->{Display}) {
-  $File->{Version} = $prettyver;
-}
-
-#
-# check the received mime type against Allowed mime types
-if ($File->{ContentType}){
-  my @allowedMediaType =
-    split(/\s+/, $CFG->{Types}->{$File->{DOCTYPE}}->{Types}->{Allowed} || '');
-  my $usedCTisAllowed;
-  if (scalar @allowedMediaType)  {
-    $usedCTisAllowed = FALSE;
-    foreach (@allowedMediaType) { $usedCTisAllowed = TRUE if ($_ eq $File->{ContentType}); }
-  }
-  else {
-    # wedon't know what media type is recommended, so better shut up
-    $usedCTisAllowed = TRUE;
-  }
-  if(! $usedCTisAllowed ){
-    &add_warning('W23', {
-        W23_type => $File->{ContentType},
-        W23_type_pref => $CFG->{Types}->{$File->{DOCTYPE}}->{Types}->{Preferred},
-        w23_doctype => $File->{Version}
-    });
-  }
-}
-
-#
-# Warn about unknown, incorrect, or missing Namespaces.
-if ($File->{Namespace}) {
-  my $ns  = $CFG->{Types}->{$File->{Version}}->{Namespace} || FALSE;
-
-  if (&is_xml($File)) {
-    if ($ns eq $File->{Namespace}) {
-      &add_warning('W10', {
-        W10_ns   => $File->{Namespace},
-        W10_type => $File->{Type},
-      });
-    }
-  } else {
-    &add_warning('W11', {W11_ns => $File->{Namespace},
-    w11_doctype => $File->{DOCTYPE}});
-  }
-} else {
-  if (&is_xml($File) and $CFG->{Types}->{$File->{Version}}->{Namespace}) {
-    &add_warning('W12', {});
-  }
-}
-
-
-## if invalid content, AND if requested, pass through tidy
-if (!$File->{'Is Valid'} && $File->{Opt}->{'Show Tidy'}) {
-  eval {
-    local $SIG{__DIE__};
-    require HTML::Tidy;
-    my $tidy = HTML::Tidy->new({config_file => $CFG->{Paths}->{TidyConf}});
-    my $cleaned = $tidy->clean(join("\n", @{$File->{Content}}));
-    $cleaned = Encode::decode_utf8($cleaned);
-    $File->{Tidy} = $cleaned;
-  };
-  if ($@) {
-    (my $errmsg = $@) =~ s/ at .*//s;
-    &add_warning('W29', { W29_msg => $errmsg });
-  }
-}
-
-my $template;
-
-if ($File->{Opt}->{Output} eq 'xml') {
-  $template = $File->{Templates}->{XML};
-} elsif ($File->{Opt}->{Output} eq 'earl') {
-  $template = $File->{Templates}->{EARLXML};
-} elsif ($File->{Opt}->{Output} eq 'n3') {
-  $template = $File->{Templates}->{EARLN3};
-} elsif ($File->{Opt}->{Output} eq 'json') {
-  $template = $File->{Templates}->{JSON};
-} elsif ($File->{Opt}->{Output} eq 'ucn') {
-  $template = $File->{Templates}->{UCN};
-} elsif ($File->{Opt}->{Output} eq 'soap12') {
-  if ($CFG->{'Enable SOAP'} != 1) { # API disabled - ideally this should have been sent before performing validation...
-    print CGI::header(-status => 503, -content_language => "en",
-    -type => "text/html", -charset => "utf-8"
-    );
-    $template = $File->{Templates}->{SOAPDisabled};
-  } elsif ($File->{'Error Flagged'}) { # should send SOAP fault message
-    $template = $File->{Templates}->{SOAPFault};
-    # we fill the soap fault template
-    #with the variables that had been passed to the HTML fatal error template
-    foreach my $fault_param ($File->{Templates}->{Error}->param()) {
-      $template->param($fault_param => $File->{Templates}->{Error}->param($fault_param));
-    }
-  } else {
-    $template = $File->{Templates}->{SOAP};
-  }
-} else {
-  $template = $File->{Templates}->{Result};
-}
-
-&prep_template($File, $template);
-&fin_template($File, $template);
-
-$template->param(file_warnings => $File->{Warnings});
-$template->param(tidy_output => $File->{Tidy});
-$template->param(file_source => &source($File))
-  if ($template->param('opt_show_source') or ($File->{'Is Upload'}) or ($File->{'Direct Input'}));
-
-if ($File->{Opt}->{Output} eq 'json') {
-  # No JSON escaping in HTML::Template (and "JS" is not the right thing here)
-  my $json = JSON->new();
-  $json->allow_nonref(TRUE);
-  for my $msgs ($template->param("file_errors"),
-                $template->param("file_warnings")) {
-    next unless $msgs;
-    for my $msg (@$msgs) {
-      for my $key (qw(msg expl)) {
-        $msg->{$key} = $json->encode($msg->{$key}) if $msg->{$key};
-      }
-    }
-  }
-}
-
-# transcode output from perl's internal to utf-8 and output
-print Encode::encode('UTF-8', $template->output);
-
-#
-# Get rid of $File object and exit.
-undef $File;
-exit;
-
-#############################################################################
-# Subroutine definitions
-#############################################################################
-
 #
 # Generate HTML report.
 sub prep_template ($$) {
Received on Monday, 5 October 2009 20:34:41 UTC

This archive was generated by hypermail 2.3.1 : Wednesday, 7 January 2015 15:17:39 UTC