view release on metacpan or  search on metacpan

lib/SOAP/Lite.pm  view on Meta::CPAN

# ======================================================================

package SOAP::Header;

use vars qw(@ISA);
@ISA = qw(SOAP::Data);

# ======================================================================

package SOAP::Serializer;
use SOAP::Lite::Utils;
use Carp ();
use vars qw(@ISA);

@ISA = qw(SOAP::Cloneable SOAP::XMLSchema::Serializer);

BEGIN {
    # namespaces and anonymous data structures
    my $ns   = 0;
    my $name = 0;
    my $prefix = 'c-';
    sub gen_ns { 'namesp' . ++$ns }
    sub gen_name { join '', $prefix, 'gensym', ++$name }
    sub prefix { $prefix =~ s/^[^\-]+-/$_[1]-/; $_[0]; }
}

sub BEGIN {
    no strict 'refs';

    __PACKAGE__->__mk_accessors(qw(readable level seen autotype attr maptype
        namespaces multirefinplace encoding signature on_nonserialized context
        ns_uri ns_prefix use_default_ns));

    for my $method (qw(method fault freeform)) { # aliases for envelope
        *$method = sub { shift->envelope($method => @_) }
    }

    # Is this necessary? Seems like work for nothing when a user could just use
    # SOAP::Utils directly.
    # for my $method (qw(qualify overqualify disqualify)) { # import from SOAP::Utils
    #   *$method = \&{'SOAP::Utils::'.$method};
    # }
}

sub DESTROY { SOAP::Trace::objects('()') }

sub new {
    my $self = shift;
    return $self if ref $self;

    my $class = $self;
    $self = bless {
        _level => 0,
        _autotype => 1,
        _readable => 0,
        _ns_uri => '',
        _ns_prefix => '',
        _use_default_ns => 1,
        _multirefinplace => 0,
        _seen => {},
        _encoding => 'UTF-8',
        _objectstack => {},
        _signature => [],
        _maptype => {},
        _bodyattr => {},
        _headerattr => {},
        _on_nonserialized => sub {Carp::carp "Cannot marshall @{[ref shift]} reference" if $^W; return},
        _encodingStyle => $SOAP::Constants::NS_ENC,
        _attr => {
            "{$SOAP::Constants::NS_ENV}encodingStyle" => $SOAP::Constants::NS_ENC,
        },
        _namespaces => {},
        _soapversion => SOAP::Lite->soapversion,
    } => $class;
    $self->typelookup({
           'base64Binary' =>
              [10, sub { $_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/ }, 'as_base64Binary'],
           'zerostring' =>
               [12, sub { $_[0] =~ /^0\d+$/ }, 'as_string'],
            # int (and actually long too) are subtle: the negative range is one greater...
            'int'  =>
               [20, sub {$_[0] =~ /^([+-]?\d+)$/ && ($1 <= 2147483647) && ($1 >= -2147483648); }, 'as_int'],
            'long' =>
               [25, sub {$_[0] =~ /^([+-]?\d+)$/ && $1 <= 9223372036854775807;}, 'as_long'],
            'float'  =>
               [30, sub {$_[0] =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+|NaN|INF)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/}, 'as_float'],
            'gMonth' =>
               [35, sub { $_[0] =~ /^--\d\d--(-\d\d:\d\d)?$/; }, 'as_gMonth'],
            'gDay' =>
               [40, sub { $_[0] =~ /^---\d\d(-\d\d:\d\d)?$/; }, 'as_gDay'],
            'gYear' =>
               [45, sub { $_[0] =~ /^-?\d\d\d\d(-\d\d:\d\d)?$/; }, 'as_gYear'],
            'gMonthDay' =>
               [50, sub { $_[0] =~ /^-\d\d-\d\d(-\d\d:\d\d)?$/; }, 'as_gMonthDay'],
            'gYearMonth' =>
               [55, sub { $_[0] =~ /^-?\d\d\d\d-\d\d(Z|([+-]\d\d:\d\d))?$/; }, 'as_gYearMonth'],
            'date' =>
               [60, sub { $_[0] =~ /^-?\d\d\d\d-\d\d-\d\d(Z|([+-]\d\d:\d\d))?$/; }, 'as_date'],
            'time' =>
               [70, sub { $_[0] =~ /^\d\d:\d\d:\d\d(\.\d\d\d)?(Z|([+-]\d\d:\d\d))?$/; }, 'as_time'],
            'dateTime' =>
               [75, sub { $_[0] =~ /^\d\d\d\d-\d\d-\d\dT\d\d:\d\d:\d\d(\.\d\d\d)?(Z|([+-]\d\d:\d\d))?$/; }, 'as_dateTime'],
            'duration' =>
               [80, sub { $_[0] !~m{^-?PT?$} && $_[0] =~ m{^
                        -?   # a optional - sign
                        P
                        (:? \d+Y )?
                        (:? \d+M )?
                        (:? \d+D )?
                        (:?
                            T(:?\d+H)?
                            (:?\d+M)?
                            (:?\d+S)?
                        )?
                        $
                    }x;
               }, 'as_duration'],
            'boolean' =>
               [90, sub { $_[0] =~ /^(true|false)$/i; }, 'as_boolean'],
            'anyURI' =>
               [95, sub { $_[0] =~ /^(urn:|http:\/\/)/i; }, 'as_anyURI'],