1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
|
{
## skip Test::Tabs
package Local::Class1;
our $USES_MITE = q[Mite::Class];
use strict;
use warnings;
BEGIN {
require Local::Role2;
our %DOES = ( q[Local::Class1] => 1, q[Local::Role2] => 1, q[Local::Role1] => 1 );
}
sub new {
my $class = ref($_[0]) ? ref(shift) : shift;
my $meta = ( $Mite::META{$class} ||= $class->__META__ );
my $self = bless {}, $class;
my $args = $meta->{HAS_BUILDARGS} ? $class->BUILDARGS( @_ ) : { ( @_ == 1 ) ? %{$_[0]} : @_ };
my $no_build = delete $args->{__no_BUILD__};
# Initialize attributes
# Enforce strict constructor
my @unknown = grep not( do { package Local::Mite; defined($_) and do { ref(\$_) eq 'SCALAR' or ref(\(my $val = $_)) eq 'SCALAR' } } ), keys %{$args}; @unknown and require Carp and Carp::croak("Unexpected keys in constructor: " . join(q[, ], sort @unknown));
# Call BUILD methods
unless ( $no_build ) { $_->($self, $args) for @{ $meta->{BUILD} || [] } };
return $self;
}
defined ${^GLOBAL_PHASE}
or eval { require Devel::GlobalDestruction; 1 }
or do { *Devel::GlobalDestruction::in_global_destruction = sub { undef; } };
sub DESTROY {
my $self = shift;
my $class = ref( $self ) || $self;
my $meta = ( $Mite::META{$class} ||= $class->__META__ );
my $in_global_destruction = defined ${^GLOBAL_PHASE}
? ${^GLOBAL_PHASE} eq 'DESTRUCT'
: Devel::GlobalDestruction::in_global_destruction();
for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
my $e = do {
local ( $?, $@ );
eval { $demolisher->( $self, $in_global_destruction ) };
$@;
};
no warnings 'misc'; # avoid (in cleanup) warnings
die $e if $e; # rethrow
}
return;
}
sub __META__ {
no strict 'refs';
require mro;
my $class = shift; $class = ref($class) || $class;
my $linear_isa = mro::get_linear_isa( $class );
return {
BUILD => [
map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
map { "$_\::BUILD" } reverse @$linear_isa
],
DEMOLISH => [
map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
map { "$_\::DEMOLISH" } @$linear_isa
],
HAS_BUILDARGS => $class->can('BUILDARGS'),
};
}
sub DOES {
my ( $self, $role ) = @_;
our %DOES;
return $DOES{$role} if exists $DOES{$role};
return 1 if $role eq __PACKAGE__;
return $self->SUPER::DOES( $role );
}
sub does {
shift->DOES( @_ );
}
1;
}
|