File Coverage

blib/lib/CXC/Astro/Regions/CFITSIO/Variant.pm
Criterion Covered Total %
statement 59 61 96.7
branch 6 10 60.0
condition 6 14 42.8
subroutine 11 12 91.6
pod 0 3 0.0
total 82 100 82.0


line stmt bran cond sub pod time code
1             package CXC::Astro::Regions::CFITSIO::Variant;
2              
3             # ABSTRACT: Generate CFITSIO Region classes
4              
5 3     3   236777 use v5.20;
  3         46  
6 3     3   19 use warnings;
  3         6  
  3         245  
7 3     3   616 use experimental 'signatures', 'postderef';
  3         1907  
  3         22  
8              
9             our $VERSION = '0.03';
10              
11 3     3   2544 use Module::Runtime 'module_notional_filename';
  3         6192  
  3         39  
12 3     3   1874 use Ref::Util qw( is_arrayref );
  3         6471  
  3         384  
13              
14              
15             use Package::Variant
16 3         31 importing => [ 'Moo', 'MooX::StrictConstructor' ],
17 3     3   2104 subs => [qw( has extends around with )];
  3         22133  
18              
19 3     3   649 use constant PREFIX => __PACKAGE__ =~ s/[^:]+$//r;
  3         8  
  3         3097  
20              
21             sub _croak {
22 0     0   0 require Carp;
23 0         0 goto \&Carp::croak;
24             }
25              
26              
27 22     22 0 562 sub make_variant_package_name ( $, $package, % ) {
  22         45  
  22         36  
28 22         115 return PREFIX . ucfirst( $package );
29             }
30              
31              
32 22     22 0 148593 sub make_variant ( $, $, $region, %args ) {
  22         77  
  22         68  
  22         43  
33              
34 22   50     85 my $params = $args{params} // [];
35 22   66     106 $region = $args{name} // $region;
36              
37 22 50 33     77 extends $args{extends}->@* if $args{extends} && $args{extends}->@*;
38              
39 22         57 my @private = qw( label );
40              
41 22         60 for my $arg ( $params->@* ) {
42 60         19597 my %has = ( is => 'ro', required => 1, $arg->%* );
43 60         192 my ( $name ) = delete @has{ 'name', @private };
44 60         230 has $name => %has;
45             }
46              
47 16     16   45495 install render => sub ( $self ) {
  16         34  
  16         23  
48 16         54 return sprintf( '%s(%s)', $region, join( q{,}, params( $self, $params ) ) );
49 22         14621 };
50              
51 22 50 33     495 around $args{around}->@* if $args{around} && $args{around}->@*;
52 22 50 33     255 with $args{with}->@* if $args{with} && $args{with}->@*;
53              
54             }
55              
56 16     16 0 23 sub params ( $self, $params ) {
  16         20  
  16         24  
  16         24  
57 16         23 my @output;
58              
59 16         38 for my $param ( $params->@* ) {
60              
61 48         100 my $name = $param->{name};
62 48         178 my @values = ( $self->$name );
63 48 50       98 next if !defined $values[0];
64              
65 48         85 while ( @values ) {
66 101         186 my $value = shift @values;
67 101 100       213 if ( is_arrayref( $value ) ) {
68 26         57 unshift @values, $value->@*;
69 26         49 next;
70             }
71 75         172 push @output, $value;
72             }
73             }
74              
75 16         173 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__