File Coverage

blib/lib/CCfnX/Shortcuts.pm
Criterion Covered Total %
statement 87 214 40.6
branch 25 90 27.7
condition 3 12 25.0
subroutine 27 59 45.7
pod 0 23 0.0
total 142 398 35.6


line stmt bran cond sub pod time code
1             package Fn;
2 14     14   1432734 use strict;
  14         35  
  14         385  
3 14     14   69 use warnings;
  14         42  
  14         4799  
4             sub Join {
5 3     3   78 my ($with, @args) = @_;
6 3         66 return { 'Fn::Join' => [ $with, [ @args ] ] };
7             }
8              
9             sub ImportValue {
10 0     0   0 my ($value) = @_;
11 0         0 return { "Fn::ImportValue" => $value };
12             }
13              
14             sub Split {
15 0     0   0 my ($delimiter, $string) = @_;
16 0         0 return { "Fn::Split" => [ $delimiter, $string ] };
17             }
18              
19             sub FindInMap {
20 0     0   0 my ($map_name, @keys) = @_;
21 0         0 return { "Fn::FindInMap" => [ $map_name, @keys ] };
22             }
23              
24             sub Sub {
25 0     0   0 my ($string, @vars) = @_;
26 0 0       0 if (@vars) {
27 0         0 return { "Fn::Sub" => [ $string, { @vars } ] };
28             } else {
29 0         0 return { "Fn::Sub" => $string };
30             }
31             }
32              
33             sub Base64 {
34 1     1   3 my ($what) = @_;
35 1         7 return { "Fn::Base64" => $what };
36             }
37              
38             sub GetAZs {
39 0     0   0 return { "Fn::GetAZs" => "" };
40             }
41              
42             sub Select {
43 0     0   0 my ($index, $array) = @_;
44 0         0 return { "Fn::Select" => [ $index, $array ] };
45             }
46              
47             sub Equals {
48 0     0   0 my $value1 = shift;
49 0         0 my $value2 = shift;
50 0 0       0 die "Fn::Equals only admits two parameters" if (@_ > 0);
51 0         0 return { "Fn::Equals" => [ $value1, $value2 ] };
52             }
53              
54             sub Not {
55 0     0   0 my $condition = shift;
56 0 0       0 die "Fn::Equals only admits one parameter" if (@_ > 0);
57 0         0 return { "Fn::Not" => [ $condition ] }
58             }
59              
60             sub If {
61 0     0   0 my $condition_name = shift;
62 0         0 my $value_true = shift;
63 0         0 my $value_false = shift;
64 0 0       0 die "Fn::If only admits three parameters" if (@_ > 0);
65 0         0 return { "Fn::If" => [ $condition_name, $value_true, $value_false ] };
66             }
67            
68             sub Or {
69 0     0   0 my @conditions = @_;
70 0         0 return { 'Fn::Or' => [ @conditions ] };
71             }
72              
73             1;
74             package CCfnX::Shortcuts;
75              
76 14     14   93 use Carp;
  14         29  
  14         918  
77 14     14   540 use Moose::Exporter;
  14         111277  
  14         103  
78            
79             Moose::Exporter->setup_import_methods(
80             with_meta => [ 'resource', 'output', 'condition', 'metadata', 'stack_version' ],
81             as_is => [ qw/Ref ConditionRef GetAtt UserData CfString Parameter Attribute FindImage ImageFor Tag GetPolicy ELBListener TCPELBListener SGRule GetASGStatus GetInstanceStatus/ ],
82             );
83              
84             sub condition {
85 0 0   0 0 0 Moose->throw_error('Usage: output \'name\' => Ref|GetAtt|{}')
86             if (@_ != 3);
87 0         0 my ( $meta, $name, $condition ) = @_;
88              
89 0 0       0 if ($meta->find_attribute_by_name($name)){
90 0         0 die "Redeclared resource/output/condition $name";
91             }
92              
93             $meta->add_attribute(
94             $name,
95             is => 'rw',
96             isa => "Cfn::Value",
97             traits => [ 'Condition' ],
98             lazy => 1,
99             coerce => 1,
100             default => sub {
101 0     0   0 $condition;
102             },
103 0         0 );
104             }
105            
106             sub resource {
107             # TODO: Adjust this error condition to better detect incorrect num of params passed
108 54 50 66 54 0 521996 Moose->throw_error('Usage: resource \'name\' => \'Type\', { key => value, ... }[, { DependsOn => ... }]')
109             if (@_ != 4 and @_ != 5);
110 54         187 my ( $meta, $name, $resource, $options, $extra ) = @_;
111              
112 54 100       222 if ($meta->find_attribute_by_name($name)){
113 1         85 die "Redeclared resource/output/condition $name";
114             }
115              
116 53 100       4882 $extra = {} if (not defined $extra);
117              
118 53         138 my %args = ();
119 53 100       257 if (ref($options) eq 'CODE'){
    50          
120 1         5 %args = &$options();
121             } elsif (ref($options) eq 'HASH'){
122 52         210 %args = %$options;
123             }
124              
125 53         3311 my $res_isa;
126 53 50       159 if ($resource =~ m/^Custom::/){
127 0         0 $res_isa = "Cfn::Resource::AWS::CloudFormation::CustomResource";
128             } else {
129 53         146 $res_isa = "Cfn::Resource::$resource";
130             }
131            
132             $meta->add_attribute(
133             $name,
134             is => 'rw',
135             isa => $res_isa,
136             traits => [ 'Resource' ],
137             lazy => 1,
138             default => sub {
139 73     73   940 return Moose::Util::TypeConstraints::find_type_constraint('Cfn::Resource')->coerce({
140             Type => $resource,
141             Properties => \%args,
142             %$extra }
143             );
144             },
145 53         363 );
146             }
147              
148             sub output {
149 4 50   4 0 76 Moose->throw_error('Usage: output \'name\' => Ref|GetAtt|{}')
150             if (@_ != 3);
151 4         12 my ( $meta, $name, $options ) = @_;
152            
153 4 50       20 if ($meta->find_attribute_by_name($name)){
154 0         0 die "Redeclared resource/output/condition $name";
155             }
156            
157 4 50       372 if (my ($att) = ($name =~ m/^\+(.*)/)) {
158             $meta->add_attribute(
159             $att,
160             is => 'rw',
161             isa => 'Cfn::Value',
162             coerce => 1,
163             traits => [ 'Output', 'PostOutput' ],
164             lazy => 1,
165 0     0   0 default => sub { return $options },
166 0         0 );
167             } else {
168             $meta->add_attribute(
169             $name,
170             is => 'rw',
171             isa => 'Cfn::Value',
172             coerce => 1,
173             traits => [ 'Output' ],
174             lazy => 1,
175             default => sub {
176 4     4   46 return $options;
177             },
178 4         34 );
179             }
180             }
181              
182             sub metadata {
183 4 50   4 0 65 Moose->throw_error('Usage: metadata \'name\' => {json-object}')
184             if (@_ != 3);
185 4         10 my ( $meta, $name, $options ) = @_;
186              
187 4 50       13 if (my ($att) = ($name =~ m/^\+(.*)/)) {
188             $meta->add_attribute(
189             $att,
190             is => 'rw',
191             isa => 'Cfn::Value',
192             coerce => 1,
193             traits => [ 'Metadata' ],
194             lazy => 1,
195 0     0   0 default => sub { return $options },
196 0         0 );
197             } else {
198             $meta->add_attribute(
199             $name,
200             is => 'rw',
201             isa => 'Cfn::Value',
202             coerce => 1,
203             traits => [ 'Metadata' ],
204             lazy => 1,
205 4     4   42 default => sub { return $options },
206 4         26 );
207             }
208             }
209              
210             sub stack_version {
211 0 0   0 0 0 Moose->throw_error('Usage: stack_version \'version\'')
212             if (@_ != 2);
213 0         0 my ( $meta, $version ) = @_;
214              
215             $meta->add_attribute(
216             'StackVersion',
217             is => 'rw',
218             isa => 'Cfn::Value',
219             coerce => 1,
220             traits => [ 'Metadata' ],
221             lazy => 1,
222 0     0   0 default => sub { return $version },
223 0         0 );
224             }
225              
226             # Moose->throw_error('Usage: resource \'name\' => ( key => value, ... )')
227             # if @_ % 2 == 1;
228             #
229             # my %context = Moose::Util::_caller_info;
230             # $context{context} = 'resource declaration';
231             # $context{type} = 'class';
232             # my %options = ( definition_context => \%context, @_ );
233             # my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
234             # $meta->add_attribute( $_, is => 'rw', isa => 'AWS::EC2::Instance', lazy => 1, %options ) for @$attrs;
235             # }
236              
237             sub GetPolicy {
238 0     0 0 0 my $param = shift;
239 0 0       0 die "Must specify an exported policy" unless defined $param;
240             return CCfnX::DynamicValue->new(Value => sub {
241 0     0   0 return @{ $_[0]->params->$param->{Policy} };
  0         0  
242 0         0 });
243             }
244              
245             sub Parameter {
246 7     7 0 25825 my $param = shift;
247 7 50       25 die "Must specify a parameter to read from" if (not defined $param);
248 7     5   78 return CCfnX::DynamicValue->new(Value => sub { return $_[0]->params->$param });
  5         104  
249             }
250            
251             sub Attribute {
252 5     5 0 10443 my $path = shift;
253 5         22 my ($attribute, $method, $rest) = split /\./, $path;
254 5 50       18 croak "Don't understand attributes with more than two path elements" if (defined $rest);
255 5 50       18 croak "Must specify an attribute read from" if (not defined $attribute);
256 5 100       15 if (not defined $method) {
257 2     2   14 return CCfnX::DynamicValue->new(Value => sub { return $_[0]->$attribute });
  2         35  
258             } else {
259 3     3   27 return CCfnX::DynamicValue->new(Value => sub { return $_[0]->$attribute->$method });
  3         56  
260             }
261             }
262              
263             sub SpecifyInSubClass {
264 0     0 0 0 return CCfnX::DynamicValue->new(Value => sub { die "You must specify a value" });
  0     0   0  
265             }
266              
267             sub Tag {
268 1     1 0 586 my ($tag_key, $tag_value, %rest) = @_;
269 1         22 { Key => $tag_key, Value => $tag_value, %rest };
270             }
271              
272             sub Ref {
273 42     42 0 62857 my $ref = shift;
274 42 50       135 die "Ref expected a logical name to reference to" if (not defined $ref);
275 42         273 return { Ref => $ref };
276             }
277              
278             sub ConditionRef {
279 0     0 0 0 my $condition = shift;
280 0 0       0 die "Condition expected a logical name to reference to" if (not defined $condition);
281 0         0 return { Condition => $condition };
282             }
283              
284             sub GetAtt {
285 8     8 0 682 my ($ref, $property) = @_;
286 8 50 33     52 die "GetAtt expected a logical name and a property name" if (not defined $ref or not defined $property);
287 8         69 { 'Fn::GetAtt' => [ $ref, $property ] }
288             }
289              
290             sub ELBListener {
291 0     0 0 0 my ($lbport, $lbprotocol, $instanceport, $instanceprotocol) = @_;
292 0 0       0 die "no port for ELB listener passed" if (not defined $lbport);
293 0 0       0 die "no protocol for ELB listener passed" if (not defined $lbprotocol);
294 0 0       0 $instanceport = $lbport if (not defined $instanceport);
295 0 0       0 $instanceprotocol = $lbprotocol if (not defined $instanceprotocol);
296              
297 0         0 return { InstancePort => $instanceport,
298             InstanceProtocol => $instanceprotocol,
299             LoadBalancerPort => $lbport,
300             Protocol => $lbprotocol
301             }
302             }
303              
304             sub TCPELBListener {
305 0     0 0 0 my ($lbport, $instanceport) = @_;
306 0         0 return ELBListener($lbport, 'TCP', $instanceport);
307             }
308              
309             # Creates a rule for a security group:
310             # IF port is a number, it opens just that port
311             # IF port is a range: number-number, it opens that port range
312             # to: where to open the rule to. If this looks like a CIDR, it will populate CidrIP in the rule,
313             # else, it will populate SourceSecurityGroupId. (This means that you can't use this shortcut
314             # to open a SG to a Ref(...) in a parameter, for example).
315             # proto: if specified, uses that protocol. If not, TCP by default
316             sub SGRule {
317 1     1 0 4 my ($port, $to, $proto) = @_;
318              
319 1         3 my ($from_port, $to_port);
320 1 50       6 if ($port =~ m/\-/) {
321 0 0       0 if ($port eq '-1') {
322 0         0 ($from_port, $to_port) = (-1, -1);
323             } else {
324 0         0 ($from_port, $to_port) = split /\-/, $port, 2;
325             }
326             } else {
327 1         4 ($from_port, $to_port) = ($port, $port);
328             }
329              
330 1 50       4 $proto = 'tcp' if (not defined $proto);
331 1         6 my $rule = { IpProtocol => $proto, FromPort => $from_port, ToPort => $to_port};
332              
333 1         2 my $key;
334             # Rules to detect when we're trying to open to a CIDR
335 1 50       8 $key = 'CidrIp' if ($to =~ m/^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\/\d{1,2}$/);
336             # Fallback to SSGroupId
337 1 50       4 $key = 'SourceSecurityGroupId' if (not defined $key);
338            
339 1         4 $rule->{ $key } = $to;
340              
341 1         7 return $rule;
342             }
343              
344             sub FindImage {
345 0     0 0 0 my ($name, %criterion) = @_;
346 0         0 require CloudDeploy::AMIDB;
347             return CCfnX::DynamicValue->new(Value => sub {
348 0     0   0 my $self = shift;
349 0         0 my $amidb = CloudDeploy::AMIDB->new;
350 0 0 0     0 if (ref($name) and $name->isa('CCfnX::DynamicValue')){
351 0         0 $name = $name->to_value($self)->Value;
352             }
353 0         0 foreach my $key (keys %criterion) {
354 0 0 0     0 if(ref($criterion{$key}) and $criterion{$key}->isa('CCfnX::DynamicValue')){
355 0         0 $criterion{$key} = $criterion{$key}->to_value($self)->Value;
356             }
357             }
358             $amidb->find(
359 0         0 Account => CloudDeploy::Config->new->account,
360             Region => $self->params->region,
361             Name => $name,
362             %criterion
363             )->prop('ImageId');
364 0         0 });
365             }
366              
367             sub OSImage {
368 0     0 0 0 require CloudDeploy::AMIDB;
369              
370             }
371              
372 14     14   22771 use CCfnX::LocateAMI;
  14         48  
  14         1622  
373             sub ImageFor {
374 0     0 0 0 my ($name, $arch, $root) = @_;
375 0         0 warn "ImageFor is getting deprecated! Substitute for FindImage('$name', Arch => '$arch', Root => '$root', Tags => '...')";
376             return CCfnX::DynamicValue->new(Value => sub {
377 0     0   0 my $self = shift;
378 0         0 return CCfnX::LocateAMI->new(
379             name => $name
380             )->ami($self->params->region, $arch, $root);
381             })
382 0         0 }
383              
384 14     14   6507 use CCfnX::UserData;
  14         53  
  14         9597  
385             sub UserData {
386 4     4 0 19198 my @args = @_;
387             return CCfnX::DynamicValue->new(Value => sub {
388 4     4   11 my @ctx = @_;
389 4         15 CCfnX::UserData->new(text => $args[0])->as_hashref(@ctx);
390 4         37 });
391             }
392              
393             sub CfString {
394 4     4 0 20937 my $string = shift;
395             return CCfnX::DynamicValue->new(Value => sub {
396 4     4   14 my @ctx = @_;
397 4         38 CCfnX::UserData->new(text => $string)->as_hashref_joins(@ctx);
398 4         43 });
399             }
400              
401             sub GetASGStatus {
402 0     0 0   my ($asg_name, %defaults) = @_;
403            
404 0           require Paws;
405            
406 0           my %dyn_values = ();
407 0           foreach my $property (keys %defaults) {
408             $dyn_values{ $property } = CCfnX::DynamicValue->new(Value => sub {
409 0     0     my $self = shift;
410 0           my $stack_name = $self->params->name;
411 0 0         if ($self->params->update) {
412             #return get_asg_info($self->params->region, $stack_name, $asg_name, $property)
413 0           my $resources = $self->stash->{ cfn_resources };
414 0 0         if (not defined $resources) {
415 0           my $res_array = Paws->service('CloudFormation',
416             region => $self->params->region
417             )->DescribeStackResources(StackName => $stack_name)->StackResources;
418            
419             $resources = $self->stash->{ cfn_resources } = { map {
420 0           ($_->LogicalResourceId => $_ )
  0            
421             } @$res_array
422             };
423             }
424            
425 0           my $asg = $self->stash->{ asg };
426 0 0         if (not defined $asg){
427 0           my $asg_physid = $resources->{ $asg_name }->PhysicalResourceId;
428 0           $asg = Paws->service('AutoScaling',
429             region => $self->params->region
430             )->DescribeAutoScalingGroups(AutoScalingGroupNames => [
431             $asg_physid
432             ]);
433 0 0         die "Didn't find autoscaling group $asg_physid" if (scalar(@{ $asg->AutoScalingGroups } == 0));
  0            
434 0           $asg = $self->stash->{ asg } = $asg->AutoScalingGroups->[0];
435             }
436            
437 0           return $asg->$property;
438             } else {
439 0           return $defaults{ $property }
440             }
441 0           });
442             }
443 0           return %dyn_values;
444             }
445            
446             sub GetInstanceStatus {
447 0     0 0   my ($instance_name, %defaults) = @_;
448            
449 0           require Paws;
450            
451 0           my %dyn_values = ();
452 0           foreach my $property (keys %defaults) {
453             $dyn_values{ $property } = CCfnX::DynamicValue->new(Value => sub {
454 0     0     my $self = shift;
455 0           my $stack_name = $self->params->name;
456 0 0         if ($self->params->update) {
457 0           my $resources = $self->stash->{ cfn_resources };
458 0 0         if (not defined $resources) {
459 0           my $res_array = Paws->service('CloudFormation',
460             region => $self->params->region
461             )->DescribeStackResources(StackName => $stack_name)->StackResources;
462            
463             $resources = $self->stash->{ cfn_resources } = { map {
464 0           ($_->LogicalResourceId => $_ )
  0            
465             } @$res_array
466             };
467             }
468            
469 0           my $instance = $self->stash->{ instance };
470 0 0         if (not defined $instance){
471 0           my $instance_physid = $resources->{ $instance_name }->PhysicalResourceId;
472 0           $instance = Paws->service('EC2',
473             region => $self->params->region
474             )->DescribeInstances(InstanceIds => [
475             $instance_physid
476             ]);
477 0 0         die "Didn't find instance $instance_physid" if (scalar(@{ $instance->Reservations } == 0));
  0            
478 0           $instance = $self->stash->{ instance } = $instance->Reservations->[0]->Instances->[0];
479             }
480            
481 0           return $instance->$property;
482             } else {
483 0           return $defaults{ $property }
484             }
485 0           });
486             }
487 0           return %dyn_values;
488             }
489            
490             1;