1package Protocol::XMLRPC::ValueFactory;
2
3use strict;
4use warnings;
5
6use B;
7use Scalar::Util qw(blessed);
8
9use Protocol::XMLRPC::Value::Double;
10use Protocol::XMLRPC::Value::String;
11use Protocol::XMLRPC::Value::Integer;
12use Protocol::XMLRPC::Value::Array;
13use Protocol::XMLRPC::Value::Boolean;
14use Protocol::XMLRPC::Value::DateTime;
15use Protocol::XMLRPC::Value::Struct;
16
17sub build {
18    my $class = shift;
19
20    return unless @_;
21
22    my ($type, $value) = @_;
23    ($value, $type) = ($type, '') unless defined $value;
24
25    return $value if blessed($value);
26
27    # From JSON::PP
28    my $flags = B::svref_2object(\$value)->FLAGS;
29    my $is_number = $flags & (B::SVp_IOK | B::SVp_NOK)
30      and !($flags & B::SVp_POK) ? 1 : 0;
31
32    if (($type && $type eq 'array') || ref($value) eq 'ARRAY') {
33        return Protocol::XMLRPC::Value::Array->new($value);
34    }
35    elsif (($type && $type eq 'struct') || ref($value) eq 'HASH') {
36        return Protocol::XMLRPC::Value::Struct->new($value);
37    }
38    elsif (($type && $type eq 'int') || ($is_number && $value =~ m/^(?:\+|-)?\d+$/)) {
39        return Protocol::XMLRPC::Value::Integer->new($value);
40    }
41    elsif (($type && $type eq 'double') || ($is_number && $value =~ m/^(?:\+|-)?\d+\.\d+$/)) {
42        return Protocol::XMLRPC::Value::Double->new($value);
43    }
44    elsif (($type && $type eq 'boolean') || ref($value) eq 'SCALAR') {
45        return Protocol::XMLRPC::Value::Boolean->new($value);
46    }
47    elsif (($type && $type eq 'datetime')
48        || $value =~ m/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d):(\d\d):(\d\d)$/)
49    {
50        return Protocol::XMLRPC::Value::DateTime->parse($value);
51    }
52
53    return Protocol::XMLRPC::Value::String->new($value);
54}
55
561;
57__END__
58
59=head1 NAME
60
61Protocol::XMLRPC::ValueFactory - value objects factory
62
63=head1 SYNOPSIS
64
65    my $array    = Protocol::XMLRPC::ValueFactory->build([...]);
66    my $struct   = Protocol::XMLRPC::ValueFactory->build({...});
67    my $integer  = Protocol::XMLRPC::ValueFactory->build(1);
68    my $double   = Protocol::XMLRPC::ValueFactory->build(1.2);
69    my $datetime = Protocol::XMLRPC::ValueFactory->build('19980717T14:08:55');
70    my $boolean  = Protocol::XMLRPC::ValueFactory->build(\1);
71    my $string   = Protocol::XMLRPC::ValueFactory->build('foo');
72
73=head1 DESCRIPTION
74
75This is a value object factory. Used internally. In synopsis you can see what
76types can be guessed.
77
78=head1 ATTRIBUTES
79
80=head1 METHODS
81
82=head2 C<build>
83
84Builds new value object. If no instance was provided tries to guess type.
85