view release on metacpan or  search on metacpan

lib/CXC/Astro/Regions/CIAO/Variant.pm  view on Meta::CPAN

package CXC::Astro::Regions::CIAO::Variant;

# ABSTRACT: Generate CIAO Region classes

use v5.20;
use warnings;
use experimental 'signatures', 'postderef';

our $VERSION = '0.03';

use Module::Runtime 'module_notional_filename';
use Ref::Util qw( is_arrayref );


use Package::Variant
  importing => [ 'Moo', 'MooX::StrictConstructor' ],
  subs      => [qw( has extends around with )];

use constant PREFIX => __PACKAGE__ =~ s/[^:]+$//r;

sub _croak {
    require Carp;
    goto \&Carp::croak;
}


sub make_variant_package_name ( $, $package, % ) {
    return PREFIX . ucfirst( $package );
}


sub make_variant ( $, $, $region, %args ) {

    my $params = $args{params} // [];
    $region = $args{name} // $region;

    extends $args{extends}->@* if $args{extends} && $args{extends}->@*;

    my @private = qw( label );

    for my $arg ( $params->@* ) {
        my %has = ( is => 'ro', required => 1, $arg->%* );
        my ( $name ) = delete @has{ 'name', @private };
        has $name => %has;
    }

    install render => sub ( $self ) {
        return sprintf( '%s(%s)', $region, join( q{,}, params( $self, $params ) ) );
    };

    around $args{around}->@* if $args{around} && $args{around}->@*;
    with $args{with}->@*     if $args{with}   && $args{with}->@*;

}

sub params ( $self, $params ) {
    my @output;

    for my $param ( $params->@* ) {

        my $name   = $param->{name};
        my @values = ( $self->$name );
        next if !defined $values[0];

        while ( @values ) {
            my $value = shift @values;
            if ( is_arrayref( $value ) ) {
                unshift @values, $value->@*;
                next;
            }
            push @output, $value;
        }