view release on metacpan or  search on metacpan

lib/Reaction/Class.pm  view on Meta::CPAN

  my %exports = $self->exports_for_package($package);
  {
    no strict 'refs';
    foreach my $nuke (keys %exports) {
      delete ${"${package}::"}{$nuke};
    }
  }
  my $unimport_class = $self->next_import_package;
  eval "package ${package}; no $unimport_class;";
  confess "$unimport_class unimport from ${package} failed: $@" if $@;
  foreach my $m (@methods) {
    $self->add_method_to_target($package, $m);
  }
  foreach my $a (@apply_after) {
    my $call = shift(@$a);
    $save_delayed{$call}->(@$a);
  }
}

sub add_method_to_target {
  my ($self, $target, $method) = @_;
  $target->meta->add_method(@$method);
}

sub delayed_methods {
  return (qw/has with extends before after around override augment/);
}

sub make_package_sub {
  my ($self, $package) = @_;
  my ($last) = (split('::', $package))[-1];
  return $last => sub {
    $self->do_package_sub($package => @_);
  };
}

sub do_package_sub {
  my $self = shift;
  my $package = shift;
  return (@_ ? ($package => @_) : $package);
}

sub make_sugar_sub {
  my ($self, $name) = @_;
  return $name => sub {
    return ($name => @_);
  };
}

sub make_code_sugar_sub {
  my ($self, $name) = @_;
  return $name => sub (;&@) {
    return ($name => @_);
  };
}

sub import {
  my $self = shift;
  my $pkg = caller;
  my @args = @_;
  strict->import;
  warnings->import;
  $self->do_import($pkg, \@args);
  goto &{$self->next_import} if $self->next_import;
}

sub next_import {
  return shift->next_import_package(@_)->can('import');
}

sub next_import_package { 'Moose' }

__PACKAGE__->meta->make_immutable;

1;

#---------#---------#---------#---------#---------#---------#---------#--------#

=head1 NAME

Reaction::Class

=head1 DESCRIPTION

=head1 SEE ALSO

=over

=item * L<Catalyst>

=item * L<Reaction::Manual>

=back

=head1 Unstructured reminders

(will properly format and stuff later.  no time right now)

C<use>ing C<Reaction::Class> will alias the current package name
see L<aliased>.

    package MyApp::Pretty::Picture

    # Picture expands to 'MyApp::Pretty::Picture'
    class Picture, which { ...

=head2 default_base

=head2 set_or_lazy_build $attrname

Will make your attributes lazy and required, if they are not set they
will default to the value returned by C<&build_$attrname>

    has created_d => (isa => 'DateTime', set_or_lazy_build('created_d') );
    sub build_created_d{ DateTime->now }

=head2 set_or_lazy_fail $attrname

Will make your attributes lazy and required, if they are not set
and their accessor is called an exception will be thrown