view release on metacpan or  search on metacpan

lib/Attribute/Default.pm  view on Meta::CPAN

## Returns:
##    hashref: list of exsubs we found and their array indices
##    arrayref: list of defaults without exsubs
##
sub _extract_exsubs_array {
  my ($defaults) = @_;

  my %exsubs = ();
  my @noexsubs = ();

  for ( $[ .. $#$defaults ) {
    if (UNIVERSAL::isa( $defaults->[$_], EXSUB_CLASS )) {
      $exsubs{$_} = $defaults->[$_];
    }
    else {
      $noexsubs[$_] = $defaults->[$_];
    }
  }

  return (\%exsubs, \@noexsubs);
}

lib/Attribute/Default.pm  view on Meta::CPAN

##
##
sub Defaults : ATTR(CODE) {
  my ($glob, $orig, $attr, $defaults) = @_[1 .. 4];
  (ref $defaults) && (ref $defaults eq 'ARRAY') or $defaults = [$defaults];

  my @ref_defaults = ();
  my @ref_exsubs = ();
  my @toplevel_defaults = ();

  foreach ($[ .. $#$defaults) {
    if ( (my $type = ref $$defaults[$_]) && (! UNIVERSAL::isa($$defaults[$_], EXSUB_CLASS) ) ) {
      my ($fill_sub, $fill_exsub) = _get_fill($$defaults[$_]);
      push @ref_defaults, [$_, $type, $fill_sub];
      defined $fill_exsub and push @ref_exsubs, [$_, $type, $fill_exsub];
    }
    else {
      $toplevel_defaults[$_] = $$defaults[$_];
    }
  }

  my ($toplevel_sub, $toplevel_exsub) = _fill_array_sub(\@toplevel_defaults);

  if ( _is_method($orig) ) {
    *$glob = 
sub {
  my @filled = &$toplevel_sub(@_[ ($[ + 1) .. $#_ ]);
  _fill_sublevel(\@filled, \@ref_defaults);
  defined ($toplevel_exsub) && &$toplevel_exsub(\@filled, [$_[0], @filled]);
  _fill_exsubs(\@filled, \@ref_exsubs, [$_[0], @filled]);
  @_ = ($_[0], @filled);
  goto $orig;
}
  }
  else {
      *$glob =
 sub {