File Coverage

File:lib/WWW/Google/Contacts/Roles/List.pm
Coverage:25.8%

linestmtbrancondsubpodtimecode
1package WWW::Google::Contacts::Roles::List;
2
3
11
11
11
82
36
122
use Moose::Role;
4
11
11
11
119
32
133
use MooseX::Types::Moose qw( ArrayRef Int );
5
11
11
11
115
36
132
use Carp qw( croak );
6
11
11
11
100
33
161
use URI::Escape;
7
11
11
11
102
41
113
use Perl6::Junction qw( any );
8
11
11
11
98
37
80
use WWW::Google::Contacts::Data;
9
10requires 'baseurl', 'element_class';
11
12has elements => (
13    isa => ArrayRef,
14    is => 'rw',
15    lazy_build => 1,
16);
17
18has server => (
19    is => 'ro',
20    required => 1,
21);
22
23has pointer => (
24    isa => Int,
25    is => 'rw',
26    default => 0,
27    init_arg => undef,
28);
29
30sub search {
31
0
0
    my ($self, $search) = @_;
32
33
0
    my $class = $self->element_class;
34
35    # TODO - make something clever to match XML keys without having to bless all the objects for comparison
36    # this could be a start;
37    #
38    #my $element = $class->new( server => $self->server );
39    #my $search_params = [];
40    #foreach my $key ( keys %{ $search } ) {
41    # my $xml_key = $element->get_xml_key( $key );
42    # if ( $xml_key ) {
43    # push @{ $search_params },
44    # {
45    # xml_key => $xml_key,
46    # value => $search->{ $key },
47    # };
48    # }
49    # else {
50    # croak "Can't find XML key for [$key]";
51    # }
52    #}
53
54    # This doesn't scale well.... SLOW
55
0
    my $to_ret = [];
56
0
    ELEM:
57
0
    foreach my $elem ( @{ $self->elements } ) {
58
0
        my $obj = $class->new( server => $self->server );
59
0
        $obj->set_from_server( $elem );
60
0
0
        foreach my $key ( keys %{ $search } ) {
61
0
            next ELEM unless ( defined $obj->$key );
62
0
            if ( ref( $obj->$key ) and ref( $obj->$key ) eq 'ARRAY' ) {
63
0
                my $search_field = $obj->$key->[0]->search_field;
64
0
                next ELEM unless ( defined $search_field );
65
0
0
0
                my @values = map { $_->$search_field } @{ $obj->$key };
66
0
                next ELEM unless ( any(@values) eq $search->{ $key } );
67            }
68            else {
69
0
                next ELEM unless ( $obj->$key eq $search->{ $key } );
70            }
71        }
72
0
0
        push @{ $to_ret }, $obj;
73    }
74
0
0
    return wantarray ? @{ $to_ret } : $to_ret;
75}
76
77sub next {
78
0
0
    my $self = shift;
79
0
    return undef unless ( $self->elements->[ $self->pointer ] );
80
0
    my $next = $self->elements->[ $self->pointer ];
81
0
    $self->pointer( $self->pointer+1 );
82
0
    my $class = $self->element_class;
83
0
    return $class->new( server => $self->server )->set_from_server( $next );
84}
85
86sub _build_elements {
87
0
    my $self = shift;
88
89
0
    my $args = {};
90
0
    $args->{'alt'} = 'atom'; # must be atom
91
0
    $args->{'max-results'} ||= 9999;
92
0
    my $group = delete $args->{group} || 'full';
93
0
    my $url = sprintf( '%s/%s?v=3.0', $self->baseurl, uri_escape($group) );
94
0
    foreach my $key (keys %$args) {
95
0
        $url .= '&' . uri_escape($key) . '=' . uri_escape($args->{$key});
96    }
97
0
    my $res = $self->server->get( $url );
98
0
    my $content = $res->content;
99
0
    my $data = WWW::Google::Contacts::Data->decode_xml( $content );
100
0
    my $array = $data->{ entry } || [];
101
102    #use Data::Dumper;
103    #print Dumper $array->[0];
104    #die;
105
106    # ..lots of overhead to bless them all now.
107    #my $class = $self->element_class;
108    #$array = [ map { $class->new( server => $self->server )->set_from_server( $_ ) } @{ $array } ];
109
0
    return $array;
110}
111
1121;