This file is indexed.

/usr/share/perl5/VM/EC2/Generic.pm is in libvm-ec2-perl 1.28-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
package VM::EC2::Generic;

=head1 NAME

VM::EC2::Generic - Base class for VM::EC2 objects

=head1 SYNOPSIS

  use VM::EC2;

 my $ec2 = VM::EC2->new(-access_key => 'access key id',
                      -secret_key => 'aws_secret_key',
                      -endpoint   => 'http://ec2.amazonaws.com');

 my $object = $ec2->some_method(...);

 # getting data fields
 my @field_names = $object->fields;

 # invoking data fields as methods
 my $request_id = $object->requestId;
 my $xmlns      = $object->xmlns;

 # tagging 
 my $tags = $object->tags;

 if ($tags->{Role} eq 'WebServer') {
    $object->delete_tags(Role=>undef);
    $object->add_tags(Role   => 'Web Server',
                      Status => 'development');
 }

 # get the parsed XML object as a hash
 my $hashref = $object->payload;

 # get the parsed XML object as a Data::Dumper string
 my $text = $object->as_string;

 # get the VM::EC2 object back
 my $ec2 = $object->ec2;

 # get the most recent error string
 warn $object->error_str;

=head1 DESCRIPTION

This is a common base class for objects returned from VM::EC2. It
provides a number of generic methods that are used in subclasses, but
is not intended to be used directly.

=head1 METHODS

=cut

use strict;
use Carp 'croak';
use Data::Dumper;
use VM::EC2 'tag';

our $AUTOLOAD;
$Data::Dumper::Terse++;
$Data::Dumper::Indent=1;

use overload
    '""'     => sub {my $self = shift;
		     return $self->short_name;
                  },
    fallback => 1;

sub AUTOLOAD {
    my $self = shift;
    my ($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
    return if $func_name eq 'DESTROY';
    my %fields = map {$_=>1} $self->valid_fields;
    my $mixed  = VM::EC2->uncanonicalize($func_name);# mixedCase
    my $flat   = VM::EC2->canonicalize($func_name);  # underscore_style
    $flat =~ s/^-//;

    if ($mixed eq $flat) {
	return $self->{data}{$mixed} if $fields{$mixed};
	return $self->{data}{ucfirst $mixed} if $fields{ucfirst $mixed};
	croak "Can't locate object method \"$func_name\" via package \"$pack\"";
    }

    if ($func_name eq $flat && $self->can($mixed)) {
	return $self->$mixed(@_);
    } elsif ($func_name eq $mixed && $self->can($flat)) {
	return $self->$flat(@_);
    } elsif ($fields{$mixed}) {
	return $self->{data}{$mixed} if $fields{$mixed};
    } elsif ($fields{ucfirst($mixed)}) {  
	# very occasionally an API field breaks Amazon's coding 
	# conventions and starts with an uppercase
	return $self->{data}{ucfirst($mixed)};
    } else {
	croak "Can't locate object method \"$func_name\" via package \"$pack\"";
    }
}

sub can {
    my $self = shift;
    my $method = shift;

    my $can  = $self->SUPER::can($method);
    return $can if $can;
    
    my %fields = map {$_=>1} $self->valid_fields;
    return \&AUTOLOAD if $fields{$method};

    return;
}

=head2 $object = VM::EC2::Generic->new($payload,$ec2 [,$xmlns, $requestId])

Given the parsed XML generated by VM::EC2::Dispatch and the VM::EC2
object, return a new object. Two optional additional arguments provide
the seldom-needed XML namespace and ID of the request that generated
this object.

=cut

sub new {
    my $self = shift;
    @_ >= 2 or croak "Usage: $self->new(\$data,\$ec2)";
    my ($data,$ec2,$xmlns,$requestid) = @_;
    return bless {data => $data,
		  aws  => $ec2,
		  xmlns => $xmlns,
		  requestId => $requestid
    },ref $self || $self;
}

=head2 $ec2 = $object->ec2

=head2 $ec2 = $object->aws

Return the VM::EC2 object that generated this object. This method can
be called as either ec2() (preferred) or aws() (deprecated).

=cut

sub ec2 {
    my $self = shift;
    my $d    = $self->{aws};
    $self->{aws} = shift if @_;
    $d;
}

sub aws {shift->ec2}

=head2 $id = $object->primary_id  (optional method)

Resources that have unique Amazon identifiers, such as images,
instances and volumes, implement the primary_id() method to return
that identifier. Resources that do not have unique identifiers, will
throw an exception if this method is called. This method is in
addition to the resource-specific ID. For example, volumes have a
unique ID, and this ID can be fetched with either of:

  $vol->volumeId;

or

  $vol->primary_id;


=head2 $xmlns = $object->xmlns

Return the XML namespace of the request that generated this object, if
any. All objects generated by direct requests on the VM::EC2 object
will return this field, but objects returned via methods calls on
these objects (objects once removed) may not.

=cut

sub xmlns     { shift->{xmlns}     }

=head2 $id = $object->requestId

Return the ID of the reuqest that generated this object, if any. All
objects generated by direct requests on the VM::EC2 object will return
this field, but objects returned via methods calls on these objects
(objects once removed) may not.

=cut

sub requestId { shift->{requestId} }

=head2 $name = $object->short_name

Return a short name for this object for use in string
interpolation. If the object has a primary_id() method, then this
returns that ID. Otherwise it returns the default Perl object name
(VM::EC2::Generic=HASH(0x99f3850). Some classes override short_name()
in order to customized information about the object. See for example
L<VM::EC2::SecurityGroup::IpPermission>.

=cut

sub short_name {
    my $self = shift;
    if ($self->can('primary_id')) {
	return $self->primary_id;
    } else {
	return overload::StrVal($self);
    }
}

=head2 $hashref = $object->payload

Return the parsed XML hashref that underlies this object. See
L<VM::EC2::Dispatch>.

=cut

sub payload { shift->{data} }


=head2 @fields = $object->fields

Return the data field names that are valid for an object of this
type. These field names correspond to tags in the XML
returned from Amazon and can then be used as method calls.

Internally, this method is called valid_fields()

=cut

sub fields    { shift->valid_fields }

sub valid_fields {
    return qw(xmlns requestId)
}

=head2 $text = $object->as_string

Return a Data::Dumper representation of the contents of this object's
payload.

=cut

sub as_string {
    my $self = shift;
    return Dumper($self->{data});
}

=head2 $hashref = $object->tags

=head2 $hashref = $object->tagSet

Return the metadata tags assigned to this resource, if any, as a
hashref. Both tags() and tagSet() work identically.

=cut

sub tags {
    my $self = shift;
    my $result = {};
    my $set  = $self->{data}{tagSet} or return $result;
    my $innerhash = $set->{item}     or return $result;
    for my $key (keys %$innerhash) {
	$result->{$key} = $innerhash->{$key}{value};
    }
    return $result;
}

sub tagSet {
    return shift->tags();
}


=head2 $boolean = $object->add_tags(Tag1=>'value1',Tag2=>'value2',...)

=head2 $boolean = $object->add_tags(\%hash)

Add one or more tags to the object. You may provide either a list of
tag/value pairs or a hashref. If no tag of the indicated name exsists
it will be created. If there is already a tag by this name, it will
be set to the provided value. The result code is true if the Amazon
resource was successfully updated.

Also see VM::EC2->add_tags() for a way of tagging multiple resources
simultaneously.

The alias add_tag() is also provided as a convenience.

=cut

sub add_tags {
    my $self = shift;
    my $taglist = ref $_[0] && ref $_[0] eq 'HASH' ? shift : {@_};
    $self->can('primary_id') or croak "You cannot tag objects of type ",ref $self;
    $self->aws->create_tags(-resource_id => $self->primary_id,
			    -tag         => $taglist);
}

sub add_tag { shift->add_tags(@_) }

=head2 $boolean = $object->delete_tags(@args)

Delete the indicated tags from the indicated resource. There are
several variants you may use:

 # delete Foo tag if it has value "bar" and Buzz tag if it has value 'bazz'
 $i->delete_tags({Foo=>'bar',Buzz=>'bazz'})  

 # same as above but using a list rather than a hashref
 $i->delete_tags(Foo=>'bar',Buzz=>'bazz')  

 # delete Foo tag if it has any value, Buzz if it has value 'bazz'
 $i->delete_tags({Foo=>undef,Buzz=>'bazz'})

 # delete Foo and Buzz tags unconditionally
 $i->delete_tags(['Foo','Buzz'])

 # delete Foo tag unconditionally
 $i->delete_tags('Foo');

Also see VM::EC2->delete_tags() for a way of deleting tags from multiple
resources simultaneously.

=cut

sub delete_tags {
    my $self = shift;
    my $taglist;

    if (ref $_[0]) {
	if (ref $_[0] eq 'HASH') {
	    $taglist = shift;
	} elsif (ref $_[0] eq 'ARRAY') {
	    $taglist = {map {$_=>undef} @{$_[0]} };
	}
    } else {
	if (@_ == 1) {
	    $taglist = {shift()=>undef};
	} else {
	    $taglist = {@_};
	}
    }

    $self->can('primary_id') or croak "You cannot delete tags from objects of type ",ref $self;
    $self->aws->delete_tags(-resource_id => $self->primary_id,
			    -tag         => $taglist);
}

sub _object_args {
    my $self = shift;
    return ($self->aws,$self->xmlns,$self->requestId);
}

=head2 $xml = $object->as_xml

Returns an XML version of the object. The object will already been
parsed by XML::Simple at this point, and so the data returned by this
method will not be identical to the XML returned by AWS.

=cut

sub as_xml {
    my $self = shift;
    XML::Simple->new->XMLout($self->payload,
			     NoAttr    => 1,
			     KeyAttr   => ['key'],
			     RootName  => 'xml',
	);
}

=head2 $value = $object->attribute('tag_name')

Returns the value of a tag in the XML returned from AWS, using a
simple heuristic. If the requested tag has a nested tag named <value>
it will return the contents of <value>. If the tag has one or more
nested tags named <item>, it will return a list of hashrefs located
within the <item> tag. Otherwise it will return the contents of
<tag_name>.

=cut

sub attribute {
    my $self = shift;
    my $attr = shift;
    my $payload = $self->payload   or return;
    my $hr      = $payload->{$attr} or return;
    return $hr->{value}   if $hr->{value};
    return @{$hr->{item}} if $hr->{item};
    return $hr;
}

=head2 $string = $object->error_str

Returns the error string for the last operation, if any, as reported
by VM::EC2.

=cut

sub error_str {
    my $self = shift;
    my $ec2  = $self->ec2 or return;
    $ec2->error_str;
}

=head2 $string = $object->error

Returns the L<VM::EC2::Error> object from the last operation, if any,
as reported by VM::EC2.

=cut

sub error {
    my $self = shift;
    my $ec2  = $self->ec2 or return;
    $ec2->error;
}

=head1 STRING OVERLOADING

This base class and its subclasses use string overloading so that the
object looks and acts like a simple string when used in a string
context (such as when printed or combined with other
strings). Typically the string corresponds to the Amazon resource ID
such as "ami-12345" and is generated by the short_name() method.

You can sort and compare the objects as if they were strings, but
despite this, object method calls work in the usual way.

=head1 SEE ALSO

L<VM::EC2>
L<VM::EC2::Dispatch>
L<VM::EC2::Generic>
L<VM::EC2::BlockDevice>
L<VM::EC2::BlockDevice::Attachment>
L<VM::EC2::BlockDevice::Mapping>
L<VM::EC2::BlockDevice::Mapping::EBS>
L<VM::EC2::ConsoleOutput>
L<VM::EC2::Error>
L<VM::EC2::Generic>
L<VM::EC2::Group>
L<VM::EC2::Image>
L<VM::EC2::Instance>
L<VM::EC2::Instance::Set>
L<VM::EC2::Instance::State>
L<VM::EC2::Instance::State::Change>
L<VM::EC2::Instance::State::Reason>
L<VM::EC2::Region>
L<VM::EC2::ReservationSet>
L<VM::EC2::SecurityGroup>
L<VM::EC2::Snapshot>
L<VM::EC2::Tag>
L<VM::EC2::Volume>

=head1 AUTHOR

Lincoln Stein E<lt>lincoln.stein@gmail.comE<gt>.

Copyright (c) 2011 Ontario Institute for Cancer Research

This package and its accompanying libraries is free software; you can
redistribute it and/or modify it under the terms of the GPL (either
version 1, or at your option, any later version) or the Artistic
License 2.0.  Refer to LICENSE for the full license text. In addition,
please see DISCLAIMER.txt for disclaimers of warranty.

=cut

1;