File Coverage

blib/lib/MongoDB/Role/_PrivateConstructor.pm
Criterion Covered Total %
statement 20 23 86.9
branch 0 2 0.0
condition 0 3 0.0
subroutine 7 8 87.5
pod n/a
total 27 36 75.0


line stmt bran cond sub pod time code
1             # Copyright 2015 - present MongoDB, Inc.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15 60     60   556464 use strict;
  60         160  
  60         1872  
16 60     60   352 use warnings;
  60         152  
  60         2351  
17             package MongoDB::Role::_PrivateConstructor;
18              
19             # MongoDB interface for a private constructor
20              
21 60     60   347 use version;
  60         152  
  60         429  
22             our $VERSION = 'v2.2.0';
23              
24 60     60   5634 use MongoDB::_Constants;
  60         188  
  60         7769  
25 60     60   433 use Sub::Defer;
  60         145  
  60         3435  
26              
27 60     60   407 use Moo::Role;
  60         169  
  60         412  
28              
29             # When assertions are enabled, the private constructor delegates to the
30             # public one, which checks required/isa assertions. When disabled,
31             # the private constructor blesses args directly to the class for speed.
32             BEGIN {
33 60     60   24589 my $NO_ASSERT_CONSTRUCTOR = <<'HERE';
34             my %done;
35             sub _new {
36             my $class = shift;
37             undefer_sub($class->can(q{new})) and $done{$class}++
38             unless $done{$class};
39             return bless {@_}, $class
40             }
41             HERE
42              
43 60 0 0 0   7600 WITH_ASSERTS
  0            
  0            
  0            
44             ? eval 'sub _new { my $class = shift; $class->new(@_) }' ## no critic
45             : eval $NO_ASSERT_CONSTRUCTOR; ## no critic
46             }
47              
48             1;