view release on metacpan or  search on metacpan

lib/W3C/SOAP/Utils.pm  view on Meta::CPAN

package W3C::SOAP::Utils;

# Created on: 2012-06-01 12:15:15
# Create by:  dev
# $Id$
# $Revision$, $HeadURL$, $Date$
# $Revision$, $Source$, $Date$

use strict;
use warnings;
use Carp;
use Scalar::Util;
use List::Util;
use Data::Dumper qw/Dumper/;
use English qw/ -no_match_vars /;
use W3C::SOAP::WSDL::Utils;
use W3C::SOAP::WSDL::Meta::Method;
use URI;

Moose::Exporter->setup_import_methods(
    as_is     => [qw/split_ns xml_error normalise_ns cmp_ns ns2module/],
    with_meta => ['operation'],
);

our $VERSION = 0.14;

sub split_ns {
    my ($tag) = @_;
    confess "No XML tag passed to split!\n" unless defined $tag;
    my ($ns, $name) = split /:/xms, $tag, 2;
    return $name ? ($ns, $name) : ('', $ns);
}

sub normalise_ns {
    my ($ns) = @_;

    my $uri = URI->new($ns);

    if ( $uri->can('host') ) {
        $uri->host(lc $uri->host);
    }

    return "$uri";
}

sub ns2module {
    my ($ns) = @_;

    my $uri = URI->new($ns);

    # URI's which have a host an a path are converted Java style name spacing
    if ( $uri->can('host') ) {
        my $module
            = join '::',
            reverse map { ucfirst $_}
            map { lc $_ }
            map { s/\W/_/gxms; $_ } ## no critic
            split /[.]/xms, $uri->host;
        $module .= join '::',
            map { s/\W/_/gxms; $_ } ## no critic
            split m{/}xms, $uri->path;
        return $module;
    }

    # other URI's are just made safe as a perl module name.
    $ns =~ s{://}{::}xms;
    $ns =~ s{([^:]:)([^:])}{$1:$2}gxms;
    $ns =~ s{[^\w:]+}{_}gxms;

    return $ns;
}

sub cmp_ns {
    my ($ns1, $ns2) = @_;

    return normalise_ns($ns1) eq normalise_ns($ns2);
}

sub xml_error {
    my ($node) = @_;
    my @lines  = split /\r?\n/xms, $node->toString;
    my $indent = '';
    if ( $lines[-1] =~ /^(\s+)/xms ) {
        $indent = $1;
    }
    my $error = $indent . $node->toString."\n at ";
    $error .= "line - ".$node->line_number.' ' if $node->line_number;
    $error .= "path - ".$node->nodePath;

    return $error;
}

1;

__END__

=head1 NAME

W3C::SOAP::Utils - Utility functions to be used with C<W3C::SOAP> modules

=head1 VERSION

This documentation refers to W3C::SOAP::Utils version 0.14.

=head1 SYNOPSIS

   use W3C::SOAP::Utils;

   # splits tags with an optional XML namespace prefix
   my ($namespace, $tag) = split_ns('xs:thing');
   # $namespace = xs
   # $tag = thing

=head1 DESCRIPTION

Utility Functions

=head1 SUBROUTINES

=over 4