File Coverage

blib/lib/CXC/Astro/Regions/CIAO/Variant.pm
Criterion Covered Total %
statement 59 61 96.7
branch 7 10 70.0
condition 6 14 42.8
subroutine 11 12 91.6
pod 0 3 0.0
total 83 100 83.0


line stmt bran cond sub pod time code
1             package CXC::Astro::Regions::CIAO::Variant;
2              
3             # ABSTRACT: Generate CIAO Region classes
4              
5 3     3   172332 use v5.20;
  3         19  
6 3     3   17 use warnings;
  3         4  
  3         193  
7 3     3   383 use experimental 'signatures', 'postderef';
  3         1130  
  3         20  
8              
9             our $VERSION = '0.03';
10              
11 3     3   5696 use Module::Runtime 'module_notional_filename';
  3         5129  
  3         19  
12 3     3   1613 use Ref::Util qw( is_arrayref );
  3         3791  
  3         318  
13              
14              
15             use Package::Variant
16 3         23 importing => [ 'Moo', 'MooX::StrictConstructor' ],
17 3     3   1556 subs => [qw( has extends around with )];
  3         16070  
18              
19 3     3   567 use constant PREFIX => __PACKAGE__ =~ s/[^:]+$//r;
  3         6  
  3         2262  
20              
21             sub _croak {
22 0     0   0 require Carp;
23 0         0 goto \&Carp::croak;
24             }
25              
26              
27 24     24 0 622 sub make_variant_package_name ( $, $package, % ) {
  24         45  
  24         39  
28 24         121 return PREFIX . ucfirst( $package );
29             }
30              
31              
32 24     24 0 158975 sub make_variant ( $, $, $region, %args ) {
  24         57  
  24         82  
  24         38  
33              
34 24   50     121 my $params = $args{params} // [];
35 24   66     115 $region = $args{name} // $region;
36              
37 24 50 33     83 extends $args{extends}->@* if $args{extends} && $args{extends}->@*;
38              
39 24         64 my @private = qw( label );
40              
41 24         67 for my $arg ( $params->@* ) {
42 54         18923 my %has = ( is => 'ro', required => 1, $arg->%* );
43 54         197 my ( $name ) = delete @has{ 'name', @private };
44 54         240 has $name => %has;
45             }
46              
47 15     15   30956 install render => sub ( $self ) {
  15         25  
  15         19  
48 15         36 return sprintf( '%s(%s)', $region, join( q{,}, params( $self, $params ) ) );
49 24         16137 };
50              
51 24 50 33     639 around $args{around}->@* if $args{around} && $args{around}->@*;
52 24 50 33     175 with $args{with}->@* if $args{with} && $args{with}->@*;
53              
54             }
55              
56 15     15 0 18 sub params ( $self, $params ) {
  15         16  
  15         18  
  15         21  
57 15         15 my @output;
58              
59 15         35 for my $param ( $params->@* ) {
60              
61 36         63 my $name = $param->{name};
62 36         87 my @values = ( $self->$name );
63 36 100       61 next if !defined $values[0];
64              
65 35         82 while ( @values ) {
66 80         101 my $value = shift @values;
67 80 100       130 if ( is_arrayref( $value ) ) {
68 22         44 unshift @values, $value->@*;
69 22         44 next;
70             }
71 58         129 push @output, $value;
72             }
73             }
74              
75 15         129 return @output;
76             }
77              
78              
79             1;
80              
81             #
82             # This file is part of CXC-Astro-Regions
83             #
84             # This software is Copyright (c) 2023 by Smithsonian Astrophysical Observatory.
85             #
86             # This is free software, licensed under:
87             #
88             # The GNU General Public License, Version 3, June 2007
89             #
90              
91             __END__