view release on metacpan or  search on metacpan

lib/App/Easer/V2.pm  view on Meta::CPAN

   map { $self->_auto_child($_, $inflate) } qw< help commands tree >;
}

sub auto_commands ($self) { return $self->_auto_child('commands', 1) }

sub auto_help ($self) { return $self->_auto_child('help', 1) }

sub auto_tree ($self) { return $self->_auto_child('tree', 1) }

sub run_help ($self, $mode = 'help') { $self->auto_help->run($mode) }

sub full_help_text ($s, @as) { $s->auto_help->collect_help_for($s, @as) }

sub load_module ($sop, $module) {
   my $file = "$module.pm" =~ s{::}{/}grmxs;
   eval { require $file } or Carp::confess("module<$module>: $EVAL_ERROR");
   return $module;
}

# Gets a specification like "Foo::Bar::baz" and returns a reference to
# sub "baz" in "Foo::Bar". If no package name is set, returns a
# reference to a sub in the package of $self. FIXME document properly
sub ref_to_sub ($self, $spec) {
   Carp::confess("undefined specification in ref_to_sub")
     unless defined $spec;
   return $spec if ref($spec) eq 'CODE';
   my ($class, $function) =
     ref($spec) eq 'ARRAY'
     ? $spec->@*
     : $spec =~ m{\A (?: (.*) :: )? (.*) \z}mxs;
   return $self->can($function) unless length($class // '');
   $self->load_module($class)   unless $class->can($function);
   return $class->can($function);
} ## end sub ref_to_sub

sub instantiate ($sop, $class, @args) {
   $sop->load_module($class) unless $class->can('new');
   return $class->new(@args);
}

sub _reparent ($self, $child) {
   $child->parent($self);
   $self->child($child); # saves a weak reference to $child

   # 2024-08-27 propagate sources configurations
   if (! ref($child->_sources)) { # still default, my need to set it
      my ($first, @rest) = $self->sources;
      if (ref($first) eq 'REF') {  # new approach, propagate
         my $ssources = $$first;
         $child->_sources(my $csources = { $ssources->%* });
         if (my $next = $ssources->{next}) {
            my @csources =
                 ref($next) eq 'ARRAY' ? $next->@*
               : ref($next) eq 'CODE'  ? $next->($child)
               :                         Carp::confess(); # no clue
            $csources->{current} = \@csources;
         }
      }
   }

   # propagate pre-execute callbacks down the line
   $child->pre_execute_schedule($self->pre_execute);

   return $child;
}

# transform one or more children "hints" into instances.
sub inflate_children ($self, @hints) {
   my $hashy = $self->hashy_class;
   map {
      my $child = $_;
      if (!blessed($child)) {    # actually inflate it
         $child =
             ref($child) eq 'ARRAY' ? $self->instantiate($child->@*)
           : ref($child) eq 'HASH'  ? $self->instantiate($hashy, $child)
           :                          $self->instantiate($child);
      } ## end if (!blessed($child))
      $self->_reparent($child);  # returns $child
   } grep { defined $_ } @hints;
} ## end sub inflate_children

# fallback mechanism when finding a child, relies on fallback_to.
sub fallback ($self) {
   my $fto = $self->fallback_to;
   return $fto if !defined($fto) || $fto !~ m{\A(?: 0 | [1-9]\d* )\z};
   my @children = $self->list_children;
   return $children[$fto] if $fto <= $#children;
   return undef;
} ## end sub fallback ($self)

# execute what's set as the execute sub in the slot
sub execute ($self) {
   my $spec = $self->_rw or die "nothing to search for execution\n";
   my $sub = $self->ref_to_sub($spec) or die "nothing to execute\n";
   return $sub->($self);
}

sub pre_execute_schedule ($self, @specs) {
   if (my $spec = $self->_rw) {
      my $sub = $self->ref_to_sub($spec) or die "nothing for pre_execute_schedule\n";
      return $sub->($self, @specs);
   }

   # default approach is to append to the current ones
   $self->pre_execute([$self->pre_execute, @specs]);
   return $self;
}

sub pre_execute_run ($self) {
   if (my $spec = $self->_rw) {
      my $sub = $self->ref_to_sub($spec) or die "nothing to pre-execute\n";
      return $sub->($self);
   }

   # default is to run 'em all
   for my $spec ($self->pre_execute) {
      my $sub = $self->ref_to_sub($spec) or die "nothing to pre-execute\n";
      $sub->($self);
   }
   return $self;
}