File Coverage

blib/lib/Protocol/XMLRPC/ValueFactory.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	21	22	95.4
condition	39	42	92.8
subroutine	12	12	100.0
pod	1	1	100.0
total	121	125	96.8

package Protocol::XMLRPC::ValueFactory;

use strict;
use warnings;

use B;
use Scalar::Util qw(blessed);

use Protocol::XMLRPC::Value::Double;
use Protocol::XMLRPC::Value::String;
use Protocol::XMLRPC::Value::Integer;
use Protocol::XMLRPC::Value::Array;
use Protocol::XMLRPC::Value::Boolean;
use Protocol::XMLRPC::Value::DateTime;
use Protocol::XMLRPC::Value::Struct;

sub build {
    my $class = shift;

    return unless @_;

    my ($type, $value) = @_;
    ($value, $type) = ($type, '') unless defined $value;

    return $value if blessed($value);

    # From JSON::PP
    my $flags = B::svref_2object(\$value)->FLAGS;
    my $is_number = $flags & (B::SVp_IOK | B::SVp_NOK)
      and !($flags & B::SVp_POK) ? 1 : 0;

    if (($type && $type eq 'array') || ref($value) eq 'ARRAY') {
        return Protocol::XMLRPC::Value::Array->new($value);
    }
    elsif (($type && $type eq 'struct') || ref($value) eq 'HASH') {
        return Protocol::XMLRPC::Value::Struct->new($value);
    }
    elsif (($type && $type eq 'int') || ($is_number && $value =~ m/^(?:\+|-)?\d+$/)) {
        return Protocol::XMLRPC::Value::Integer->new($value);
    }
    elsif (($type && $type eq 'double') || ($is_number && $value =~ m/^(?:\+|-)?\d+\.\d+$/)) {
        return Protocol::XMLRPC::Value::Double->new($value);
    }
    elsif (($type && $type eq 'boolean') || ref($value) eq 'SCALAR') {
        return Protocol::XMLRPC::Value::Boolean->new($value);
    }
    elsif (($type && $type eq 'datetime')
        || $value =~ m/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d):(\d\d):(\d\d)$/)
    {
        return Protocol::XMLRPC::Value::DateTime->parse($value);
    }

    return Protocol::XMLRPC::Value::String->new($value);
}

1;
__END__