File Coverage

blib/lib/Clustericious/Client/Object.pm
Criterion Covered Total %
statement 46 46 100.0
branch 16 20 80.0
condition 8 12 66.6
subroutine 9 9 100.0
pod 1 1 100.0
total 80 88 90.9


line stmt bran cond sub pod time code
1             package Clustericious::Client::Object;
2              
3 7     7   43535 use strict;
  7         14  
  7         234  
4 7     7   44 use warnings;
  7         16  
  7         967  
5              
6             # ABSTRACT: default object returned from client methods
7             our $VERSION = '0.85'; # VERSION
8              
9              
10             sub new
11             {
12 17     17 1 2788 my $class = shift;
13 17         30 my ($self, $client) = @_;
14              
15 17 50       44 return $self unless ref $self;
16              
17 17 100       45 if (ref $self eq 'ARRAY')
18             {
19 5         10 foreach (@$self)
20             {
21 11 100       38 $_ = $class->new($_, $client) if ref eq 'HASH';
22             }
23 5         13 return $self;
24             }
25              
26 7     7   35 while (my ($attr, $type) = do { no strict 'refs'; each %{"${class}::classes"} })
  7         16  
  7         2587  
  12         15  
  14         14  
  14         90  
27             {
28 2         138 eval "require $type";
29              
30 2 50       17 if (exists $self->{$attr})
31             {
32 2         19 $self->{$attr} = $type->new($self->{$attr}, $client)
33             }
34             }
35              
36 12         24 bless $self, $class;
37              
38 12         46 $self->_client($client);
39              
40 12         30 return $self;
41             }
42              
43             {
44             my %clientcache;
45              
46              
47             sub _client
48             {
49 13     13   16 my $self = shift;
50 13         15 my ($client) = @_;
51            
52 13 100       73 $client ? ($clientcache{$self} = $client) : $clientcache{$self};
53             }
54              
55             sub DESTROY
56             {
57 12     12   6116 delete $clientcache{shift};
58             }
59             }
60              
61             sub AUTOLOAD
62             {
63 8     8   2326 my $self = shift;
64              
65 8         50 my ($class, $called) = our $AUTOLOAD =~ /^(.+)::([^:]+)$/;
66              
67             my $sub = sub
68             {
69 14     14   371 my $self = shift;
70 14         17 my ($value) = @_;
71              
72 14 100       34 $self->{$called} = $value if defined $value; # Can't set undef
73            
74 14         49 $value = $self->{$called};
75              
76 14 100 100     73 if (ref $value eq 'HASH' or ref $value eq 'ARRAY')
77             {
78 4         12 $value = __PACKAGE__->new($value);
79             }
80              
81 14 50 66     145 return wantarray && !defined($value) ? ()
    100 66        
    50 33        
82             : wantarray && (ref $value eq 'ARRAY') ? @$value
83             : wantarray && (ref $value) ? %$value
84             : $value;
85 8         35 };
86              
87 7     7   39 do { no strict 'refs'; *{ "${class}::$called" } = $sub };
  7         13  
  7         1177  
  8         12  
  8         11  
  8         35  
88              
89 8         23 $self->$called(@_);
90             }
91              
92             1;
93              
94              
95              
96             =pod
97              
98             =head1 NAME
99              
100             Clustericious::Client::Object - default object returned from client methods
101              
102             =head1 VERSION
103              
104             version 0.85
105              
106             =head1 SYNOPSIS
107              
108             my $obj = Clustericious::Client::Object->new({some => 'stuff'});
109              
110             $obj->some; # 'stuff'
111             $obj->some('foo'); # Set to 'foo'
112              
113             #----------------------------------------------------------------------
114              
115             package Foo::Object;
116              
117             use base 'Clustericious::Client::Object';
118              
119             sub meth { ... };
120              
121             #----------------------------------------------------------------------
122              
123             package Foo::OtherObject;
124              
125             use base 'Clustericious::Client::Object';
126              
127             our %classes =
128             (
129             myobj => 'Foo::Object'
130             );
131              
132             #----------------------------------------------------------------------
133              
134             my $obj = Foo::Client::OtherObj({ myobj => { my => 'foo' },
135             some => 'stuff' });
136              
137             $obj->myobj->meth();
138             $obj->myobj->my; # 'foo'
139             $obj->some; # 'stuff'
140              
141             =head1 DESCRIPTION
142              
143             The Clustericious::Client derived methods receive a possibly
144             nested/complex data structure with their results. This Object helps
145             turn those data structures into simple (or possibly more complex)
146             objects.
147              
148             By default, it just makes a method for each attribute in the returned
149             data structure. It does this lazily through AUTOLOAD, so it won't
150             make them unless you are using them. If used as a base class, you can
151             override new() to do more initialization (possibly using the client to
152             download more information), or add other methods to the object as
153             needed.
154              
155             A %classes hash can also be included in a derived class specifying
156             classes to use for certain attributes.
157              
158             Each Clustericious::Client::Object derived object can also call
159             $obj->_client to get the original client if it was stored with new()
160             (L does this). This can be used by derived
161             object methods to further interact with the REST server.
162              
163             =head1 METHODS
164              
165             =head2 C
166              
167             my $obj = Clustericious::Client::Object->new({ some => 'stuff'});
168              
169             my $obj = Clustericious::Client::Object->new([ { some => 'stuff' } ]);
170              
171             Makes a hash into an object (or an array of hashes into an array of
172             objects).
173              
174             You can access or update elements of the hash using method calls:
175             my $x = $obj->some;
176             $obj->some('foo');
177              
178             In the array case, you can do my $x = $obj->[0]->some;
179              
180             If a derived class has a %classes package variable, new() will
181             automatically call the right new() for each specified attribute. (See
182             synopsis and examples).
183              
184             You can also include an optional 'client' parameter:
185              
186             my $obj = Clustericious::Client::Object->new({ ...}, $client);
187              
188             that can be retrieved with $obj->_client(). This is useful for
189             derived objects methods which need to access the Clustericious server.
190              
191             =head2 C<_client>
192              
193             my $obj->_client->do_something();
194              
195             Access the stashed client. This is useful within derived class
196             methods that need to interact with the server.
197              
198             =head1 SEE ALSO
199              
200             These are also interesting:
201              
202             Data::AsObject
203             Data::Autowrap
204             Hash::AsObject
205             Class::Builtin::Hash
206             Hash::AutoHash
207             Hash::Inflator
208             Data::OpenStruct::Deep
209             Object::AutoAccessor
210              
211             Mojo::Base
212             Clustericious::Config
213              
214             =head1 AUTHOR
215              
216             original author: Curt Tilmes
217              
218             current maintainer: Graham Ollis
219              
220             contributors:
221              
222             Brian Duggan
223              
224             =head1 COPYRIGHT AND LICENSE
225              
226             This software is copyright (c) 2013 by NASA GSFC.
227              
228             This is free software; you can redistribute it and/or modify it under
229             the same terms as the Perl 5 programming language system itself.
230              
231             =cut
232              
233              
234             __END__