The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;
use Test::More;
use Path::Class;
use Data::Dumper qw/Dumper/;
use File::ShareDir qw/dist_dir/;
use Template;
use W3C::SOAP qw/load_wsdl/;
use WWW::Mechanize;
use File::Temp qw/ tempfile tempdir /;
use XML::LibXML;

#
# This script tests W3C-SOAP against real world WSDL files gathered from the xmethods.com site.
# Before checking any WSDL against W3C::SOAP the WSDL is downloaded and
# validated only if there no problems encountered will it try to run a test
#

my $dir = file($0)->parent;
my $wsdls = $dir->file('wsdls.txt')->openr;

plan( skip_all => 'Test can only be run if test directory is writable' ) if !-w $dir;

# set up templates
my $mech = WWW::Mechanize->new;
$mech->timeout(2);
my $count = 1;
my $skipped = 0;

while (my $wsdl = <$wsdls>) {
    next if $wsdl =~ /^#/;
    next if $wsdl =~ /^\s*$/;
    next if $ENV{SKIP} && $ENV{SKIP}--;

    chomp $wsdl;
    SKIP: {
        eval {
            $skipped++;
            get_dependencies($wsdl);
            test_wsdl($wsdl);
            $skipped = 0;
        };
        skip "The WSDL ($wsdl) can't be retreived or is not valid", 1
            if $@;
    };
}
done_testing;

sub test_wsdl {
    my ($wsdl) = @_;

    # create the parser object
    my @cmd = ( qw/perl -MW3C::SOAP=load_wsdl -e/, "load_wsdl(q{$wsdl})" );
    note join ' ', @cmd, "\n";
    my $error = system @cmd;
    ok !$error, "Loaded $wsdl"
        or BAIL_OUT("Error: $error");
    return;
}

# check that the WSDLs & XSDs can be downloaded, parsed as XML documents and validated
sub get_dependencies {
    my ($url, $xsd) = @_;
    my $xml = XML::LibXML->load_xml(location => $url);

    # write the XML document to disk
    my ($fh, $xml_file) = tempfile();
    print {$fh} $xml->toString;
    my $not_valid = system "xmllint --schema '". ($xsd ? 'http://www.w3.org/2001/XMLSchema.xsd' : 'http://schemas.xmlsoap.org/wsdl/' ) . "' '$xml_file' >/dev/null 2>/dev/null";
    die "Not valid" if $not_valid;

    # look for any XSDs imported or included
    my $xpc = XML::LibXML::XPathContext->new($xml);
    $xpc->registerNs(xsd  => 'http://www.w3.org/2001/XMLSchema');

    my @xsds = $xpc->findnodes('//xsd:import');
    push @xsds, $xpc->findnodes('//xsd:include');

    while ( my $xsd = shift @xsds ) {
        my $loc = $xsd->getAttribute('schemaLocation') || $xsd->getAttribute('namespace');
        if ( $url && $url =~ m{^(?:https?|ftp)://} ) {
            $loc = URI->new_abs($loc, $url) . '';
        }
        my $file = get_dependencies($loc, 1);
    }

    return;
}