view release on metacpan or  search on metacpan

utils/grammar-to-pod  view on Meta::CPAN

#! /usr/bin/env perl

use v5.26;
use strict;
use warnings;
use Feature::Compat::Try;
use experimental 'declared_refs', 'refaliasing', 'signatures', 'builtin';
use builtin 'true', 'false';


use Image::DS9::Grammar;
use Image::DS9::PConsts;
use DDP;
use Data::Dump;

## no critic (Modules::ProhibitMultiplePackages)

package    #
  SubCommand {
    use Moo;
    use MooX::StrictConstructor;
    use experimental 'declared_refs', 'refaliasing', 'signatures';

    use Ref::Util 'is_arrayref';
    use Safe::Isa;

    use Image::DS9::PConsts qw( QNONE QARGS QYES QONLY STRING );

    use Types::Standard       qw( ArrayRef Bool InstanceOf );
    use Types::Common::String qw( NonEmptyStr );

    use constant Token => 'Image::DS9::Parser::Token';

    use constant TokenType => InstanceOf [Token];

    has tokens => (
        is      => 'ro',
        isa     => ArrayRef [ NonEmptyStr | TokenType ],
        default => sub { [] },
    );

    sub has_tokens ( $self ) {
        !!$self->tokens->@*;
    }

    has comment => (
        is        => 'ro',
        predicate => 1,
    );

    has query => (
        is      => 'ro',
        default => QYES,
    );

    has rvals => (
        is        => 'ro',
        isa       => ArrayRef [TokenType],
        predicate => 1,
    );

    has args => (
        is      => 'ro',
        isa     => ArrayRef [TokenType],
        default => sub { [] },
    );

    sub has_args ( $self ) {
        !!$self->args->@*;
    }

    has attrs => (
        is      => 'ro',
        isa     => ArrayRef,
        default => sub { [] },
    );

    sub has_attrs ( $self ) { !!$self->attrs->@* }

    has [ 'bufarg', 'chomp', 'cvt', 'retref' ] => (
        is  => 'ro',
        isa => Bool,
    );

utils/grammar-to-pod  view on Meta::CPAN

        my @attrs = $attrs->@*;
        my @pairs;
        while ( my ( $key, $value ) = splice( @attrs, 0, 2 ) ) {
            push @pairs, sprintf( q{%s => %s}, $key, $self->_attr_value_to_string( $value ) );
        }

        return join( ', ', @pairs );
    }

    sub attrs_to_string ( $self ) {
        return $self->has_attrs ? $self->_attrs_to_string( $self->attrs ) : undef;
    }

    sub components_to_string ( $self ) {
        return {
            tokens => $self->tokens_to_string,
            args   => $self->args_to_string,
            rvals  => $self->rvals_to_string,
        };
    }

    around BUILDARGS => sub ( $orig, $class, @args ) {

        my $args = $class->$orig( @args );

        # this repeats logic in Parser::parse_spec. Shouldn't
        $args->{query} //= QYES;

        # sanity checks
        die( 'query is QONLY and found args: ', Data::Dump::pp( $args ) )
          if $args->{query} & QONLY && ( $args->{args} // [] )->@*;

        if ( $args->{query} != QNONE && $args->{query} != QONLY ) {
            $args->{rvals} //= $args->{args}
              if exists $args->{args};
        }

        if ( $args->{query} != QNONE ) {
            # by default it just returns things as a string if
            # rvals wasn't specified.
            $args->{rvals} //= [STRING];
        }

        return $args;
    };

}

package    #
  Command {

    use DDP;
    use Data::Dump qw( dd pp );
    use Moo;
    use MooX::StrictConstructor;
    use builtin 'true', 'false';
    use experimental 'declared_refs', 'refaliasing', 'signatures', 'builtin';

    use Safe::Isa;
    use Ref::Util 'is_arrayref', 'is_blessed_ref', 'is_ref', 'is_coderef', 'is_regexpref';

    use Types::Standard       qw( ArrayRef Bool InstanceOf );
    use Types::Common::String qw( NonEmptyStr );
    use Iterator::Flex::Common 'iproduct', 'iter';
    use Image::DS9::PConsts qw( QNONE QARGS QYES QONLY QATTR );
    use Image::DS9::Util 'is_TODO';
    use Feature::Compat::Try;

    has name => (
        is       => 'ro',
        required => 1,
        isa      => NonEmptyStr,
    );

    has implemented => (
        is       => 'ro',
        required => 1,
        isa      => Bool,
    );

    has subcommands => (
        is       => 'ro',
        isa      => ArrayRef [ InstanceOf ['SubCommand'] ],
        required => 1,
    );

    sub _generate_output ( $self, $subcommand, $form_query = false ) {

        my $format = q{};
        my @values;

        my $query = $subcommand->query;

        return () if $form_query && $query == QNONE;

        return () if !$form_query && $query & QONLY;

        if ( $form_query ) {
            $format .= '[ %s ] = ';
            push @values, $subcommand->rvals_to_string;
        }

        $format .= '$ds9->%s';
        push @values, $self->name;

        my @args;

        push @args, $subcommand->tokens_to_string if $subcommand->has_tokens;

        push @args, $subcommand->args_to_string
          if $subcommand->has_args && ( !$form_query || ( $form_query && $query != QYES ) );

        push @args, sprintf( '?{ %s }', $subcommand->attrs_to_string )
          if $subcommand->has_attrs && ( !$form_query || ( $form_query && $query & QATTR ) );

        if ( @args ) {
            $format .= '( %s )';
            push @values, join( ', ', @args );
        }