#!/usr/bin/perl # # THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED # WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE # DISCLAIMED. IN NO EVENT SHALL NETMESH INC. BE LIABLE FOR ANY DIRECT, # INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED # OF THE POSSIBILITY OF SUCH DAMAGE. # # The use of this software is governed by a license agreement that # is contained in the package that you downloaded. package MyErrorHandler; use strict; use vars qw(@ISA); @ISA = qw(XML::Xerces::PerlErrorHandler); my $errorBuffer = undef; sub warning { my $line = $_[1]->getLineNumber; my $column = $_[1]->getColumnNumber; my $message = $_[1]->getMessage; $errorBuffer .= "WARNING: Line $line, Column $column: $message\n"; } sub error { my $line = $_[1]->getLineNumber; my $column = $_[1]->getColumnNumber; my $message = $_[1]->getMessage; $errorBuffer .= "ERROR: Line $line, Column $column: $message\n"; } sub fatal_error { my $line = $_[1]->getLineNumber; my $column = $_[1]->getColumnNumber; my $message = $_[1]->getMessage; $errorBuffer .= "FATAL: Line $line, Column $column: $message\n"; } sub getErrors { return $errorBuffer; } 1; ##### package main; use strict; use CGI; use XML::Xerces; use LWP::Simple; use File::Temp; my $q = new CGI(); my $url = $q->param( 'url' ); my $content = < NetMesh script: Test validity of an XRDS document

NetMesh script: Test validity of an XRDS document

HTML if( $url ) { $content .= <Test result:

Document: $url

HTML my $error = performCheck( $url ); if( $error ) { $content .= "
\n" . $error . "
\n"; } else { $content .= "

No errors found.

\n"; } $content .= < HTML } $content .= <New test:

Enter the URL to an XRDS document that you would like to check:

Go back

HTML return( $content, 'text/html'); ##### sub performCheck { my $url = shift; my $errorHandler = MyErrorHandler->new; my $parser = XML::Xerces::XMLReaderFactory::createXMLReader(); $parser->setErrorHandler( $errorHandler ); my $contentHandler = new XML::Xerces::PerlContentHandler() ; $parser->setContentHandler($contentHandler) ; eval { $parser->setFeature("$XML::Xerces::XMLUni::fgSAX2CoreNameSpaces", 1 ); $parser->setFeature("$XML::Xerces::XMLUni::fgSAX2CoreNameSpacePrefixes", 1 ); $parser->setFeature("$XML::Xerces::XMLUni::fgSAX2CoreValidation", 1); $parser->setFeature("$XML::Xerces::XMLUni::fgXercesDynamic", 1); $parser->setFeature("$XML::Xerces::XMLUni::fgXercesSchema", 1 ); $parser->setFeature("$XML::Xerces::XMLUni::fgXercesSchemaFullChecking", 1 ); $parser->setFeature("$XML::Xerces::XMLUni::fgXercesValidationErrorAsFatal", 0 ); }; return $@ if $@; my $input = LWP::Simple::get( $url ); return "Could not open URL $url." unless( $input ); my( $inputFh, $inputFile ) = File::Temp::tempfile( UNLINK => 0 ); print $inputFh $input; close( $inputFh ); eval { my $is = XML::Xerces::LocalFileInputSource->new( $inputFile ); $parser->parse($is) ; } ; unlink $inputFile; return $@ if $@; my $error = $errorHandler->getErrors(); return $error if( $error ); return undef; } ####