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