File Coverage

/tmp/4z41t7fRmw.mite.pm
Criterion Covered Total %
statement 81 100 81.0
branch 25 50 50.0
condition 6 27 22.2
subroutine 16 17 94.1
pod n/a
total 128 194 65.9


line stmt bran cond sub pod time code
1             {
2             package MyTest4;
3 3     3   72 use Storable ();
  3         30  
  3         195  
4 3     3   72 use strict;
  3         18  
  3         348  
5 3     3   42 use warnings;
  3         33  
  3         672  
6 3     3   30 no warnings qw( once void );
  3         48  
  3         1473  
7              
8             our $USES_MITE = "Mite::Class";
9             our $MITE_SHIM = "Mite::Shim";
10             our $MITE_VERSION = "0.012000";
11             # Mite keywords
12             BEGIN {
13 3     3   48 my ( $SHIM, $CALLER ) = ( "Mite::Shim", "MyTest4" );
14 3         27 ( *after, *around, *before, *extends, *has, *signature_for, *with ) = do {
15             package Mite::Shim;
16 3     3   54 no warnings 'redefine';
  3         12  
  3         1524  
17             (
18 0         0 sub { $SHIM->HANDLE_after( $CALLER, "class", @_ ) },
19 0         0 sub { $SHIM->HANDLE_around( $CALLER, "class", @_ ) },
20 0         0 sub { $SHIM->HANDLE_before( $CALLER, "class", @_ ) },
21             sub {},
22 12         57 sub { $SHIM->HANDLE_has( $CALLER, has => @_ ) },
23 0         0 sub { $SHIM->HANDLE_signature_for( $CALLER, "class", @_ ) },
24 0         0 sub { $SHIM->HANDLE_with( $CALLER, @_ ) },
25 3         285 );
26             };
27             };
28              
29             # Gather metadata for constructor and destructor
30             sub __META__ {
31 3     3   111 no strict 'refs';
  3         390  
  3         4167  
32 3   33 3   15 my $class = shift; $class = ref($class) || $class;
  3         18  
33 3         24 my $linear_isa = mro::get_linear_isa( $class );
34             return {
35             BUILD => [
36 3 50       9 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  3         18  
  0         0  
37 3         12 map { "$_\::BUILD" } reverse @$linear_isa
38             ],
39             DEMOLISH => [
40 3 50       6 map { ( *{$_}{CODE} ) ? ( *{$_}{CODE} ) : () }
  3         51  
  0         0  
41 3         9 map { "$_\::DEMOLISH" } @$linear_isa
  3         9  
42             ],
43             HAS_BUILDARGS => $class->can('BUILDARGS'),
44             HAS_FOREIGNBUILDARGS => $class->can('FOREIGNBUILDARGS'),
45             };
46             }
47              
48              
49             # Standard Moose/Moo-style constructor
50             sub new {
51 3 50   3   531 my $class = ref($_[0]) ? ref(shift) : shift;
52 3   33     27 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
53 3         6 my $self = bless {}, $class;
54 3 50       21 my $args = $meta->{HAS_BUILDARGS} ? $class->BUILDARGS( @_ ) : { ( @_ == 1 ) ? %{$_[0]} : @_ };
  0 50       0  
55 3         9 my $no_build = delete $args->{__no_BUILD__};
56              
57             # Attribute on_read
58             # has declaration, file ../../../../tmp/4z41t7fRmw, line 3
59 3 50       9 if ( exists $args->{"on_read"} ) { $self->{"on_read"} = $args->{"on_read"}; } ;
  3         15  
60              
61             # Attribute on_write
62             # has declaration, file ../../../../tmp/4z41t7fRmw, line 9
63 3 50       210 $args->{"on_write"} = Storable::dclone( $args->{"on_write"} ) if exists( $args->{"on_write"} );
64 3 50       15 if ( exists $args->{"on_write"} ) { $self->{"on_write"} = $args->{"on_write"}; } ;
  3         6  
65              
66             # Attribute on_both
67             # has declaration, file ../../../../tmp/4z41t7fRmw, line 15
68 3 50       33 $args->{"on_both"} = Storable::dclone( $args->{"on_both"} ) if exists( $args->{"on_both"} );
69 3 50       9 if ( exists $args->{"on_both"} ) { $self->{"on_both"} = $args->{"on_both"}; } ;
  3         6  
70              
71             # Attribute on_neither
72             # has declaration, file ../../../../tmp/4z41t7fRmw, line 21
73 3 50       9 if ( exists $args->{"on_neither"} ) { $self->{"on_neither"} = $args->{"on_neither"}; } ;
  3         9  
74              
75              
76             # Call BUILD methods
77 3 50 33     24 $self->BUILDALL( $args ) if ( ! $no_build and @{ $meta->{BUILD} || [] } );
  3 50       24  
78              
79             # Unrecognized parameters
80 3 50       6 my @unknown = grep not( /\Aon_(?:both|neither|read|write)\z/ ), keys %{$args}; @unknown and Mite::Shim::croak( "Unexpected keys in constructor: " . join( q[, ], sort @unknown ) );
  3         60  
  3         21  
81              
82 3         15 return $self;
83             }
84              
85             # Used by constructor to call BUILD methods
86             sub BUILDALL {
87 0     0   0 my $class = ref( $_[0] );
88 0   0     0 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
89 0 0       0 $_->( @_ ) for @{ $meta->{BUILD} || [] };
  0         0  
90             }
91              
92             # Destructor should call DEMOLISH methods
93             sub DESTROY {
94 3     3   1917 my $self = shift;
95 3   33     15 my $class = ref( $self ) || $self;
96 3   33     9 my $meta = ( $Mite::META{$class} ||= $class->__META__ );
97 3 50       12 my $in_global_destruction = defined ${^GLOBAL_PHASE}
98             ? ${^GLOBAL_PHASE} eq 'DESTRUCT'
99             : Devel::GlobalDestruction::in_global_destruction();
100 3 50       6 for my $demolisher ( @{ $meta->{DEMOLISH} || [] } ) {
  3         12  
101 0         0 my $e = do {
102 0         0 local ( $?, $@ );
103 0         0 eval { $demolisher->( $self, $in_global_destruction ) };
  0         0  
104 0         0 $@;
105             };
106 3     3   27 no warnings 'misc'; # avoid (in cleanup) warnings
  3         21  
  3         1941  
107 0 0       0 die $e if $e; # rethrow
108             }
109 3         15 return;
110             }
111              
112             my $__XS = !$ENV{PERL_ONLY} && eval { require Class::XSAccessor; Class::XSAccessor->VERSION("1.19") };
113              
114             # Accessors for on_both
115             # has declaration, file ../../../../tmp/4z41t7fRmw, line 15
116 6 100   6   180 sub on_both { @_ > 1 ? do { my $cloned = Storable::dclone( $_[1] ); $_[0]{"on_both"} = $cloned; $_[0]; } : ( Storable::dclone( $_[0]{"on_both"} ) ) }
  3         30  
  3         6  
  3         9  
117              
118             # Accessors for on_neither
119             # has declaration, file ../../../../tmp/4z41t7fRmw, line 21
120             if ( $__XS ) {
121             Class::XSAccessor->import(
122             chained => 1,
123             "accessors" => { "on_neither" => "on_neither" },
124             );
125             }
126             else {
127             *on_neither = sub { @_ > 1 ? do { $_[0]{"on_neither"} = $_[1]; $_[0]; } : ( $_[0]{"on_neither"} ) };
128             }
129              
130             # Accessors for on_read
131             # has declaration, file ../../../../tmp/4z41t7fRmw, line 3
132 6 100   6   18252 sub on_read { @_ > 1 ? do { $_[0]{"on_read"} = $_[1]; $_[0]; } : ( Storable::dclone( $_[0]{"on_read"} ) ) }
  3         6  
  3         9  
133              
134             # Accessors for on_write
135             # has declaration, file ../../../../tmp/4z41t7fRmw, line 9
136 6 100   6   81 sub on_write { @_ > 1 ? do { my $cloned = Storable::dclone( $_[1] ); $_[0]{"on_write"} = $cloned; $_[0]; } : ( $_[0]{"on_write"} ) }
  3         114  
  3         9  
  3         9  
137              
138              
139             # See UNIVERSAL
140             sub DOES {
141 21     21   42 my ( $self, $role ) = @_;
142 21         24 our %DOES;
143 21 50       48 return $DOES{$role} if exists $DOES{$role};
144 21 50       33 return 1 if $role eq __PACKAGE__;
145 21 50 0     45 if ( $INC{'Moose/Util.pm'} and my $meta = Moose::Util::find_meta( ref $self or $self ) ) {
      33        
146 0 0 0     0 $meta->can( 'does_role' ) and $meta->does_role( $role ) and return 1;
147             }
148 21         99 return $self->SUPER::DOES( $role );
149             }
150              
151             # Alias for Moose/Moo-compatibility
152             sub does {
153 21     21   2535 shift->DOES( @_ );
154             }
155              
156             1;
157             }