File Coverage

blib/lib/UltraDNS/Type.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package UltraDNS::Type;

=head1 NAME

UltraDNS::Type - Classes for argument and result value data types

=head1 DESCRIPTION

This is an internal module.

=cut

use strict;
use warnings;

use RPC::XML;


my %udns_types = (

    # type list for arguments, generated by mk_methods.pl and manually copied here

    # XXX we're happy to subclass int to unsigned, for example,
    # because we know that RPC::XML::int doesn't do any range validation.
    float       => {
        base => 'RPC::XML::double',
    },
    hexint      => {
        base => 'RPC::XML::string',
    },
    hostname    => {
        base => 'RPC::XML::string',
    },
    id          => {
        base => 'RPC::XML::string',
    },
    integer     => {
        base => 'RPC::XML::int',
    },
    ip_address  => {
        base => 'RPC::XML::string',
    },
    ipv6_address    => {
        base => 'RPC::XML::string',
    },
    unsigned    => {
        base => 'RPC::XML::int',
    },
    unsigned_short  => {
        base => 'RPC::XML::int',
    },
    zonename    => {
        base => 'RPC::XML::string',
    },

    # type list for result types not listed above
    soa_record  => {
        base => 'RPC::XML::struct',
    },
    ns_record   => {
        base => 'RPC::XML::struct',
    },
    a_record    => {
        base => 'RPC::XML::struct',
    },
    aaaa_record => {
        base => 'RPC::XML::struct',
    },
    ptr_record  => {
        base => 'RPC::XML::struct',
    },
    cname_record    => {
        base => 'RPC::XML::struct',
    },
    mx_record   => {
        base => 'RPC::XML::struct',
    },
    txt_record  => {
        base => 'RPC::XML::struct',
    },
    ds_record   => {
        base => 'RPC::XML::struct',
    },
    rp_record   => {
        base => 'RPC::XML::struct',
    },
    crs_mail_record => {
        base => 'RPC::XML::struct',
    },
    crs_web_record  => {
        base => 'RPC::XML::struct',
    },
);


for my $type (keys %udns_types) {
    my $info = $udns_types{$type};
    my $base = $info->{base}
        or die "No base class defined for $type type";
    my $class = "RPC::XML::$type";

    no strict 'refs'; ## no critic
    die "Class $class already exists"
        if @{"${class}::ISA"};
    @{"${class}::ISA"} = ($base);

    if ($type =~ m/_/) {
        # we need to compensate for the default as_string method that will
        # replace '_' with '.' in the type name, by installing our own in
        # our subclass that doesn't do that.
        *{"${class}::as_string"} = sub {
            my $self = shift;
            my $class = ref $self;
            $class =~ s/^.*\://;
            return "<$class>$$self";
        };
    }
}


sub _type_to_class_map {
    return { map { $_ => "RPC::XML::$_" } keys %udns_types }
}

1;