view release on metacpan or  search on metacpan

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

package CXC::Astro::Regions::DS9::Variant;

# ABSTRACT: Generate DS9 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} // [];
    my $props  = $args{props}  // [];
    $region = $args{name} // $region;

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

    # if a region has a text *parameter*, don't add a text *property*
    my $has_text_param;

    my @private = qw( label format render );

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

    for my $arg ( $props->@* ) {
        my %has = ( is => 'ro', required => 0, $arg->%* );
        my ( $name ) = delete @has{ 'name', @private };
        next if $has_text_param && $name eq 'text';
        has $name => %has;
    }

    install render => sub ( $self ) {
        my @output;
        push @output, q{#} if $args{comment};
        push @output, ( $self->include ? q{} : q{-} ) . $region;
        push @output, params( $self, $params );
        my @props = props( $self, $props, has_text_param => $has_text_param );

        push @output, q{#}, @props if @props;

        return join q{ }, @output;
    };

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