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 61     61   572813 use strict;
  61         163  
  61         1927  
16 61     61   344 use warnings;
  61         142  
  61         2357  
17             package MongoDB::Role::_PrivateConstructor;
18              
19             # MongoDB interface for a private constructor
20              
21 61     61   338 use version;
  61         144  
  61         400  
22             our $VERSION = 'v2.2.1';
23              
24 61     61   5650 use MongoDB::_Constants;
  61         146  
  61         8015  
25 61     61   440 use Sub::Defer;
  61         140  
  61         3496  
26              
27 61     61   400 use Moo::Role;
  61         160  
  61         446  
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 61     61   24650 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 61 0 0 0   7932 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;