1package VM::EC2::Generic;
2
3=head1 NAME
4
5VM::EC2::Generic - Base class for VM::EC2 objects
6
7=head1 SYNOPSIS
8
9  use VM::EC2;
10
11 my $ec2 = VM::EC2->new(-access_key => 'access key id',
12                      -secret_key => 'aws_secret_key',
13                      -endpoint   => 'http://ec2.amazonaws.com');
14
15 my $object = $ec2->some_method(...);
16
17 # getting data fields
18 my @field_names = $object->fields;
19
20 # invoking data fields as methods
21 my $request_id = $object->requestId;
22 my $xmlns      = $object->xmlns;
23
24 # tagging
25 my $tags = $object->tags;
26
27 if ($tags->{Role} eq 'WebServer') {
28    $object->delete_tags(Role=>undef);
29    $object->add_tags(Role   => 'Web Server',
30                      Status => 'development');
31 }
32
33 # get the parsed XML object as a hash
34 my $hashref = $object->payload;
35
36 # get the parsed XML object as a Data::Dumper string
37 my $text = $object->as_string;
38
39 # get the VM::EC2 object back
40 my $ec2 = $object->ec2;
41
42 # get the most recent error string
43 warn $object->error_str;
44
45=head1 DESCRIPTION
46
47This is a common base class for objects returned from VM::EC2. It
48provides a number of generic methods that are used in subclasses, but
49is not intended to be used directly.
50
51=head1 METHODS
52
53=cut
54
55use strict;
56use Carp 'croak';
57use Data::Dumper;
58use VM::EC2 'tag';
59
60our $AUTOLOAD;
61$Data::Dumper::Terse++;
62$Data::Dumper::Indent=1;
63
64use overload
65    '""'     => sub {my $self = shift;
66		     return $self->short_name;
67                  },
68    fallback => 1;
69
70sub AUTOLOAD {
71    my $self = shift;
72    my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
73    return if $func_name eq 'DESTROY';
74    my %fields = map {$_=>1} $self->valid_fields;
75    my $mixed  = VM::EC2->uncanonicalize($func_name);# mixedCase
76    my $flat   = VM::EC2->canonicalize($func_name);  # underscore_style
77    $flat =~ s/^-//;
78
79    if ($mixed eq $flat) {
80	return $self->{data}{$mixed} if $fields{$mixed};
81	return $self->{data}{ucfirst $mixed} if $fields{ucfirst $mixed};
82	croak "Can't locate object method \"$func_name\" via package \"$pack\"";
83    }
84
85    if ($func_name eq $flat && $self->can($mixed)) {
86	return $self->$mixed(@_);
87    } elsif ($func_name eq $mixed && $self->can($flat)) {
88	return $self->$flat(@_);
89    } elsif ($fields{$mixed}) {
90	return $self->{data}{$mixed} if $fields{$mixed};
91    } elsif ($fields{ucfirst($mixed)}) {
92	# very occasionally an API field breaks Amazon's coding
93	# conventions and starts with an uppercase
94	return $self->{data}{ucfirst($mixed)};
95    } else {
96	croak "Can't locate object method \"$func_name\" via package \"$pack\"";
97    }
98}
99
100sub can {
101    my $self = shift;
102    my $method = shift;
103
104    my $can  = $self->SUPER::can($method);
105    return $can if $can;
106
107    my %fields = map {$_=>1} $self->valid_fields;
108    return \&AUTOLOAD if $fields{$method};
109
110    return;
111}
112
113=head2 $object = VM::EC2::Generic->new($payload,$ec2 [,$xmlns, $requestId])
114
115Given the parsed XML generated by VM::EC2::Dispatch and the VM::EC2
116object, return a new object. Two optional additional arguments provide
117the seldom-needed XML namespace and ID of the request that generated
118this object.
119
120=cut
121
122sub new {
123    my $self = shift;
124    @_ >= 2 or croak "Usage: $self->new(\$data,\$ec2)";
125    my ($data,$ec2,$xmlns,$requestid) = @_;
126    return bless {data => $data,
127		  aws  => $ec2,
128		  xmlns => $xmlns,
129		  requestId => $requestid
130    },ref $self || $self;
131}
132
133=head2 $ec2 = $object->ec2
134
135=head2 $ec2 = $object->aws
136
137Return the VM::EC2 object that generated this object. This method can
138be called as either ec2() (preferred) or aws() (deprecated).
139
140=cut
141
142sub ec2 {
143    my $self = shift;
144    my $d    = $self->{aws};
145    $self->{aws} = shift if @_;
146    $d;
147}
148
149sub aws {shift->ec2}
150
151=head2 $id = $object->primary_id  (optional method)
152
153Resources that have unique Amazon identifiers, such as images,
154instances and volumes, implement the primary_id() method to return
155that identifier. Resources that do not have unique identifiers, will
156throw an exception if this method is called. This method is in
157addition to the resource-specific ID. For example, volumes have a
158unique ID, and this ID can be fetched with either of:
159
160  $vol->volumeId;
161
162or
163
164  $vol->primary_id;
165
166=back
167
168=head2 $xmlns = $object->xmlns
169
170Return the XML namespace of the request that generated this object, if
171any. All objects generated by direct requests on the VM::EC2 object
172will return this field, but objects returned via methods calls on
173these objects (objects once removed) may not.
174
175=cut
176
177sub xmlns     { shift->{xmlns}     }
178
179=head2 $id = $object->requestId
180
181Return the ID of the reuqest that generated this object, if any. All
182objects generated by direct requests on the VM::EC2 object will return
183this field, but objects returned via methods calls on these objects
184(objects once removed) may not.
185
186=cut
187
188sub requestId { shift->{requestId} }
189
190=head2 $name = $object->short_name
191
192Return a short name for this object for use in string
193interpolation. If the object has a primary_id() method, then this
194returns that ID. Otherwise it returns the default Perl object name
195(VM::EC2::Generic=HASH(0x99f3850). Some classes override short_name()
196in order to customized information about the object. See for example
197L<VM::EC2::SecurityGroup::IpPermission>.
198
199=cut
200
201sub short_name {
202    my $self = shift;
203    if ($self->can('primary_id')) {
204	return $self->primary_id;
205    } else {
206	return overload::StrVal($self);
207    }
208}
209
210=head2 $hashref = $object->payload
211
212Return the parsed XML hashref that underlies this object. See
213L<VM::EC2::Dispatch>.
214
215=cut
216
217sub payload { shift->{data} }
218
219
220=head2 @fields = $object->fields
221
222Return the data field names that are valid for an object of this
223type. These field names correspond to tags in the XML
224returned from Amazon and can then be used as method calls.
225
226Internally, this method is called valid_fields()
227
228=cut
229
230sub fields    { shift->valid_fields }
231
232sub valid_fields {
233    return qw(xmlns requestId)
234}
235
236=head2 $text = $object->as_string
237
238Return a Data::Dumper representation of the contents of this object's
239payload.
240
241=cut
242
243sub as_string {
244    my $self = shift;
245    return Dumper($self->{data});
246}
247
248=head2 $hashref = $object->tags
249
250=head2 $hashref = $object->tagSet
251
252Return the metadata tags assigned to this resource, if any, as a
253hashref. Both tags() and tagSet() work identically.
254
255=cut
256
257sub tags {
258    my $self = shift;
259    my $result = {};
260    my $set  = $self->{data}{tagSet} or return $result;
261    my $innerhash = $set->{item}     or return $result;
262    for my $key (keys %$innerhash) {
263	$result->{$key} = $innerhash->{$key}{value};
264    }
265    return $result;
266}
267
268sub tagSet {
269    return shift->tags();
270}
271
272
273=head2 $boolean = $object->add_tags(Tag1=>'value1',Tag2=>'value2',...)
274
275=head2 $boolean = $object->add_tags(\%hash)
276
277Add one or more tags to the object. You may provide either a list of
278tag/value pairs or a hashref. If no tag of the indicated name exsists
279it will be created. If there is already a tag by this name, it will
280be set to the provided value. The result code is true if the Amazon
281resource was successfully updated.
282
283Also see VM::EC2->add_tags() for a way of tagging multiple resources
284simultaneously.
285
286The alias add_tag() is also provided as a convenience.
287
288=cut
289
290sub add_tags {
291    my $self = shift;
292    my $taglist = ref $_[0] && ref $_[0] eq 'HASH' ? shift : {@_};
293    $self->can('primary_id') or croak "You cannot tag objects of type ",ref $self;
294    $self->aws->create_tags(-resource_id => $self->primary_id,
295			    -tag         => $taglist);
296}
297
298sub add_tag { shift->add_tags(@_) }
299
300=head2 $boolean = $object->delete_tags(@args)
301
302Delete the indicated tags from the indicated resource. There are
303several variants you may use:
304
305 # delete Foo tag if it has value "bar" and Buzz tag if it has value 'bazz'
306 $i->delete_tags({Foo=>'bar',Buzz=>'bazz'})
307
308 # same as above but using a list rather than a hashref
309 $i->delete_tags(Foo=>'bar',Buzz=>'bazz')
310
311 # delete Foo tag if it has any value, Buzz if it has value 'bazz'
312 $i->delete_tags({Foo=>undef,Buzz=>'bazz'})
313
314 # delete Foo and Buzz tags unconditionally
315 $i->delete_tags(['Foo','Buzz'])
316
317 # delete Foo tag unconditionally
318 $i->delete_tags('Foo');
319
320Also see VM::EC2->delete_tags() for a way of deleting tags from multiple
321resources simultaneously.
322
323=cut
324
325sub delete_tags {
326    my $self = shift;
327    my $taglist;
328
329    if (ref $_[0]) {
330	if (ref $_[0] eq 'HASH') {
331	    $taglist = shift;
332	} elsif (ref $_[0] eq 'ARRAY') {
333	    $taglist = {map {$_=>undef} @{$_[0]} };
334	}
335    } else {
336	if (@_ == 1) {
337	    $taglist = {shift()=>undef};
338	} else {
339	    $taglist = {@_};
340	}
341    }
342
343    $self->can('primary_id') or croak "You cannot delete tags from objects of type ",ref $self;
344    $self->aws->delete_tags(-resource_id => $self->primary_id,
345			    -tag         => $taglist);
346}
347
348sub _object_args {
349    my $self = shift;
350    return ($self->aws,$self->xmlns,$self->requestId);
351}
352
353=head2 $xml = $object->as_xml
354
355Returns an XML version of the object. The object will already been
356parsed by XML::Simple at this point, and so the data returned by this
357method will not be identical to the XML returned by AWS.
358
359=cut
360
361sub as_xml {
362    my $self = shift;
363    XML::Simple->new->XMLout($self->payload,
364			     NoAttr    => 1,
365			     KeyAttr   => ['key'],
366			     RootName  => 'xml',
367	);
368}
369
370=head2 $value = $object->attribute('tag_name')
371
372Returns the value of a tag in the XML returned from AWS, using a
373simple heuristic. If the requested tag has a nested tag named <value>
374it will return the contents of <value>. If the tag has one or more
375nested tags named <item>, it will return a list of hashrefs located
376within the <item> tag. Otherwise it will return the contents of
377<tag_name>.
378
379=cut
380
381sub attribute {
382    my $self = shift;
383    my $attr = shift;
384    my $payload = $self->payload   or return;
385    my $hr      = $payload->{$attr} or return;
386    return $hr->{value}   if $hr->{value};
387    return @{$hr->{item}} if $hr->{item};
388    return $hr;
389}
390
391=head2 $string = $object->error_str
392
393Returns the error string for the last operation, if any, as reported
394by VM::EC2.
395
396=cut
397
398sub error_str {
399    my $self = shift;
400    my $ec2  = $self->ec2 or return;
401    $ec2->error_str;
402}
403
404=head2 $string = $object->error
405
406Returns the L<VM::EC2::Error> object from the last operation, if any,
407as reported by VM::EC2.
408
409=cut
410
411sub error {
412    my $self = shift;
413    my $ec2  = $self->ec2 or return;
414    $ec2->error;
415}
416
417=head1 STRING OVERLOADING
418
419This base class and its subclasses use string overloading so that the
420object looks and acts like a simple string when used in a string
421context (such as when printed or combined with other
422strings). Typically the string corresponds to the Amazon resource ID
423such as "ami-12345" and is generated by the short_name() method.
424
425You can sort and compare the objects as if they were strings, but
426despite this, object method calls work in the usual way.
427
428=head1 SEE ALSO
429
430L<VM::EC2>
431L<VM::EC2::Dispatch>
432L<VM::EC2::Generic>
433L<VM::EC2::BlockDevice>
434L<VM::EC2::BlockDevice::Attachment>
435L<VM::EC2::BlockDevice::Mapping>
436L<VM::EC2::BlockDevice::Mapping::EBS>
437L<VM::EC2::ConsoleOutput>
438L<VM::EC2::Error>
439L<VM::EC2::Generic>
440L<VM::EC2::Group>
441L<VM::EC2::Image>
442L<VM::EC2::Instance>
443L<VM::EC2::Instance::Set>
444L<VM::EC2::Instance::State>
445L<VM::EC2::Instance::State::Change>
446L<VM::EC2::Instance::State::Reason>
447L<VM::EC2::Region>
448L<VM::EC2::ReservationSet>
449L<VM::EC2::SecurityGroup>
450L<VM::EC2::Snapshot>
451L<VM::EC2::Tag>
452L<VM::EC2::Volume>
453
454=head1 AUTHOR
455
456Lincoln Stein E<lt>lincoln.stein@gmail.comE<gt>.
457
458Copyright (c) 2011 Ontario Institute for Cancer Research
459
460This package and its accompanying libraries is free software; you can
461redistribute it and/or modify it under the terms of the GPL (either
462version 1, or at your option, any later version) or the Artistic
463License 2.0.  Refer to LICENSE for the full license text. In addition,
464please see DISCLAIMER.txt for disclaimers of warranty.
465
466=cut
467
4681;
469
470