view release on metacpan or  search on metacpan

script/pick-random-lines  view on Meta::CPAN

#
#  if (!$IN_APPLY_ROLES and _want_backcompat_hack($me)) {
#    local $IN_APPLY_ROLES = 1;
#    foreach my $role (@roles) {
#      $me->apply_single_role_to_package($to, $role);
#    }
#  }
#
#  my $role_methods;
#  foreach my $step ($me->role_application_steps) {
#    foreach my $role (@roles) {
#      # conflicting methods are supposed to be treated as required by the
#      # composed role. we don't have an actual composed role, but because
#      # we know the target class already provides them, we can instead
#      # pretend that the roles don't do for the duration of application.
#      $role_methods = $role_methods{$role} and (
#        (local @{$role_methods}{@have_conflicts}),
#        (delete @{$role_methods}{@have_conflicts}),
#      );
#
#      $me->$step($to, $role);
#    }
#  }
#  $APPLIED_TO{$to}{join('|',@roles)} = 1;
#}
#
#sub _composite_info_for {
#  my ($me, @roles) = @_;
#  $COMPOSITE_INFO{join('|', sort @roles)} ||= do {
#    my %methods;
#    foreach my $role (@roles) {
#      my $this_methods = $me->_concrete_methods_of($role);
#      $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
#    }
#    delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
#    +{ conflicts => \%methods }
#  };
#}
#
#sub _check_requires {
#  my ($me, $to, $name, $requires) = @_;
#  $requires ||= $INFO{$name}{requires} || [];
#  if (my @requires_fail = grep !$to->can($_), @$requires) {
#    # role -> role, add to requires, role -> class, error out
#    if (my $to_info = $INFO{$to}) {
#      push @{$to_info->{requires}||=[]}, @requires_fail;
#    } else {
#      croak "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail);
#    }
#  }
#}
#
#sub _non_methods {
#  my ($me, $role) = @_;
#  my $info = $INFO{$role} or return {};
#
#  my %non_methods = %{ $info->{non_methods} || {} };
#
#  # this is only for backwards compatibility with older Moo, which
#  # reimplements method tracking rather than calling our method
#  my %not_methods = reverse %{ $info->{not_methods} || {} };
#  return \%non_methods unless keys %not_methods;
#
#  my $subs = $me->_all_subs($role);
#  for my $sub (grep !/\A\(/, keys %$subs) {
#    my $code = $subs->{$sub};
#    if (exists $not_methods{$code}) {
#      $non_methods{$sub} = $code;
#    }
#  }
#
#  return \%non_methods;
#}
#
#sub _concrete_methods_of {
#  my ($me, $role) = @_;
#  my $info = $INFO{$role};
#
#  return $info->{methods}
#    if $info && $info->{methods};
#
#  my $non_methods = $me->_non_methods($role);
#
#  my $subs = $me->_all_subs($role);
#  for my $sub (keys %$subs) {
#    if ( exists $non_methods->{$sub} && $non_methods->{$sub} == $subs->{$sub} ) {
#      delete $subs->{$sub};
#    }
#  }
#
#  if ($info) {
#    $info->{methods} = $subs;
#  }
#  return $subs;
#}
#
#sub methods_provided_by {
#  my ($me, $role) = @_;
#  $me->_require_module($role);
#  croak "${role} is not a ${me}" unless $me->is_role($role);
#  sort (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
#}
#
#sub _install_methods {
#  my ($me, $to, $role) = @_;
#
#  my $methods = $me->_concrete_methods_of($role);
#
#  my %existing_methods;
#  @existing_methods{keys %{ $me->_all_subs($to) }} = ();
#
#  # _concrete_methods_of caches its result on roles.  that cache needs to be
#  # invalidated after applying roles
#  delete $INFO{$to}{methods} if $INFO{$to};
#
#  foreach my $i (keys %$methods) {
#    next
#      if exists $existing_methods{$i};
#
#    my $glob = _getglob "${to}::${i}";
#    *$glob = $methods->{$i};
#
#    # overloads using method names have the method stored in the scalar slot
#    # and &overload::nil in the code slot.
#    next
#      unless $i =~ /^\(/
#        && ((defined &overload::nil && $methods->{$i} == \&overload::nil)

script/pick-random-lines  view on Meta::CPAN

#  };
#  no warnings 'redefine';
#  return *{_getglob "${to}::DOES"} = $new_sub;
#}
#
## optimize for newer perls
#require mro
#  if "$]" >= 5.009_005;
#
#if (defined &mro::get_linear_isa) {
#  *_linear_isa = \&mro::get_linear_isa;
#}
#else {
#  my $e;
#  {
#    local $@;
## this routine is simplified and not fully compatible with mro::get_linear_isa
## but for our use the order doesn't matter, so we don't need to care
#    eval <<'END_CODE' or $e = $@;
#sub _linear_isa($;$) {
#  if (defined &mro::get_linear_isa) {
#    no warnings 'redefine', 'prototype';
#    *_linear_isa = \&mro::get_linear_isa;
#    goto &mro::get_linear_isa;
#  }
#
#  my @check = shift;
#  my @lin;
#
#  my %found;
#  while (defined(my $check = shift @check)) {
#    push @lin, $check;
#    no strict 'refs';
#    unshift @check, grep !$found{$_}++, @{"$check\::ISA"};
#  }
#
#  return \@lin;
#}
#
#1;
#END_CODE
#  }
#  die $e if defined $e;
#}
#
#sub does_role {
#  my ($proto, $role) = @_;
#  foreach my $class (@{_linear_isa(ref($proto)||$proto)}) {
#    return 1 if exists $APPLIED_TO{$class}{$role};
#  }
#  return 0;
#}
#
#sub is_role {
#  my ($me, $role) = @_;
#  return !!($INFO{$role} && (
#    $INFO{$role}{is_role}
#    # these are for backward compatibility with older Moo that overrode some
#    # methods without calling the originals, thus not getting is_role set
#    || $INFO{$role}{requires}
#    || $INFO{$role}{not_methods}
#    || $INFO{$role}{non_methods}
#  ));
#}
#
#1;
#__END__
#
#=encoding utf-8
#
#=head1 NAME
#
#Role::Tiny - Roles: a nouvelle cuisine portion size slice of Moose
#
#=head1 SYNOPSIS
#
# package Some::Role;
#
# use Role::Tiny;
#
# sub foo { ... }
#
# sub bar { ... }
#
# around baz => sub { ... };
#
# 1;
#
#elsewhere
#
# package Some::Class;
#
# use Role::Tiny::With;
#
# # bar gets imported, but not foo
# with 'Some::Role';
#
# sub foo { ... }
#
# # baz is wrapped in the around modifier by Class::Method::Modifiers
# sub baz { ... }
#
# 1;
#
#If you wanted attributes as well, look at L<Moo::Role>.
#
#=head1 DESCRIPTION
#
#C<Role::Tiny> is a minimalist role composition tool.
#
#=head1 ROLE COMPOSITION
#
#Role composition can be thought of as much more clever and meaningful multiple
#inheritance.  The basics of this implementation of roles is:
#
#=over 2
#
#=item *
#
#If a method is already defined on a class, that method will not be composed in
#from the role. A method inherited by a class gets overridden by the role's