File Coverage

File:lib/WWW/Google/Contacts/Base.pm
Coverage:17.0%

linestmtbrancondsubpodtimecode
1package WWW::Google::Contacts::Base;
2
3
12
12
12
82
39
83
use Moose;
4
12
12
12
133
37
101
use Scalar::Util qw( blessed );
5
6sub xml_attributes {
7
38
0
148
    my $self = shift;
8
38
206
275
10490
    return grep { $_->does( 'XmlField' ) }
9        $self->meta->get_all_attributes;
10}
11
12sub get_xml_key {
13
0
0
    my ($self, $field) = @_;
14
15
0
    foreach my $attr ( $self->xml_attributes ) {
16
0
        my $name = $attr->name;
17
0
        my $val = $self->$name;
18
0
        if ( $name eq $field ) {
19
0
            return $attr->xml_key;
20        }
21        elsif ( blessed($val) and $val->can("to_xml_hashref") ) {
22
0
            my $recurse = $val->get_xml_key( $field );
23
0
            if ( $recurse ) {
24
0
                my $parent = $attr->xml_key;
25
0
                return { $parent => $recurse };
26            }
27        }
28    }
29
0
    return undef;
30}
31
32sub to_xml_hashref {
33
0
0
    my $self = shift;
34
35
0
    my $to_return = {};
36
0
    foreach my $attr ( $self->xml_attributes ) {
37
0
        my $incl = $attr->include_in_xml;
38
0
        next unless $self->$incl;
39
40
0
        my $predicate = $attr->predicate;
41
42
0
        next if defined $predicate
43            and not $self->$predicate
44            and not $attr->is_lazy;
45
46
0
        my $name = $attr->name;
47
0
        my $val = $self->$name;
48
49
0
        $to_return->{ $attr->xml_key } =
50            ( blessed($val) and $val->can("to_xml_hashref") ) ? $val->to_xml_hashref
51
0
            : ( ref($val) and ref($val) eq 'ARRAY' ) ? [ map { $_->to_xml_hashref } @{ $val } ]
52
0
0
0
            : $attr->has_to_xml ? do { my $code = $attr->to_xml ; &$code( $val ) }
53            : $attr->is_element ? [ $val ]
54            : $val;
55    }
56
0
    return $to_return;
57}
58
59sub set_from_server {
60
0
0
    my ($self, $data) = @_;
61
62
0
    foreach my $attr ( $self->xml_attributes ) {
63
0
        if ( defined $data->{ $attr->xml_key } ) {
64
0
            if ( my $writer = $attr->writer ) {
65                # write attributes that are read only to the user
66
0
                $self->$writer( $data->{ $attr->xml_key } );
67            }
68            else {
69
0
                my $name = $attr->name;
70
0
                $self->$name( $data->{ $attr->xml_key } );
71            }
72        }
73    }
74
0
    return $self;
75}
76
77around BUILDARGS => sub {
78    my $orig = shift;
79    my $class = shift;
80
81    return $class->$orig() unless ( @_ );
82
83    # let's see if we need to mangle xml fields
84    my $data;
85    if ( @_ > 1 ) {
86        $data = {@_};
87    }
88    else {
89        $data = shift @_;
90    }
91
92    foreach my $attr ( $class->xml_attributes ) {
93        if ( defined $data->{ $attr->xml_key } ) {
94            $data->{ $attr->name } = delete $data->{ $attr->xml_key };
95        }
96    }
97    return $class->$orig( $data );
98};
99
100
12
12
12
140
38
90
no Moose;
101__PACKAGE__->meta->make_immutable;
1021;