← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:05 2021

Filename/usr/local/lib/perl5/site_perl/Specio/Constraint/Role/IsaType.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSpecio::Constraint::Role::IsaType::::BEGIN@10Specio::Constraint::Role::IsaType::BEGIN@10
0000s0sSpecio::Constraint::Role::IsaType::::BEGIN@12Specio::Constraint::Role::IsaType::BEGIN@12
0000s0sSpecio::Constraint::Role::IsaType::::BEGIN@14Specio::Constraint::Role::IsaType::BEGIN@14
0000s0sSpecio::Constraint::Role::IsaType::::BEGIN@3Specio::Constraint::Role::IsaType::BEGIN@3
0000s0sSpecio::Constraint::Role::IsaType::::BEGIN@4Specio::Constraint::Role::IsaType::BEGIN@4
0000s0sSpecio::Constraint::Role::IsaType::::BEGIN@8Specio::Constraint::Role::IsaType::BEGIN@8
0000s0sSpecio::Constraint::Role::IsaType::::BEGIN@9Specio::Constraint::Role::IsaType::BEGIN@9
0000s0sSpecio::Constraint::Role::IsaType::::CORE:matchSpecio::Constraint::Role::IsaType::CORE:match (opcode)
0000s0sSpecio::Constraint::Role::IsaType::::__ANON__Specio::Constraint::Role::IsaType::__ANON__ (xsub)
0000s0sSpecio::Constraint::Role::IsaType::::__ANON__[:90]Specio::Constraint::Role::IsaType::__ANON__[:90]
0000s0sSpecio::Constraint::Role::IsaType::::__ANON__[:93]Specio::Constraint::Role::IsaType::__ANON__[:93]
0000s0sSpecio::Constraint::Role::IsaType::::_attrsSpecio::Constraint::Role::IsaType::_attrs
0000s0sSpecio::Constraint::Role::IsaType::::_wrap_message_generatorSpecio::Constraint::Role::IsaType::_wrap_message_generator
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Specio::Constraint::Role::IsaType;
2
3use strict;
4use warnings;
5
6our $VERSION = '0.47';
7
8use Scalar::Util qw( blessed );
9use Specio::PartialDump qw( partial_dump );
10use Storable qw( dclone );
11
12use Role::Tiny;
13
14use Specio::Constraint::Role::Interface;
15with 'Specio::Constraint::Role::Interface';
16
17{
18 ## no critic (Subroutines::ProtectPrivateSubs)
19 my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() );
20 ## use critic
21
22 for my $name (qw( parent _inline_generator )) {
23 $attrs->{$name}{init_arg} = undef;
24 $attrs->{$name}{builder}
25 = $name =~ /^_/ ? '_build' . $name : '_build_' . $name;
26 }
27
28 $attrs->{class} = {
29 isa => 'ClassName',
30 required => 1,
31 };
32
33 ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
34 sub _attrs {
35 return $attrs;
36 }
37}
38
39## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
40sub _wrap_message_generator {
41 my $self = shift;
42 my $generator = shift;
43
44 my $type = ( split /::/, blessed $self)[-1];
45 my $class = $self->class;
46 my $allow_classes = $self->_allow_classes;
47
48 unless ( defined $generator ) {
49 $generator = sub {
50 shift;
51 my $value = shift;
52
53 return "An undef will never pass an $type check (wants $class)"
54 unless defined $value;
55
56 if ( ref $value && !blessed $value) {
57 my $dump = partial_dump($value);
58 return
59 "An unblessed reference ($dump) will never pass an $type check (wants $class)";
60 }
61
62 if ( !blessed $value) {
63 return
64 "An empty string will never pass an $type check (wants $class)"
65 unless length $value;
66
67 if (
68 $value =~ /\A
69 \s*
70 -?[0-9]+(?:\.[0-9]+)?
71 (?:[Ee][\-+]?[0-9]+)?
72 \s*
73 \z/xs
74 ) {
75 return
76 "A number ($value) will never pass an $type check (wants $class)";
77 }
78
79 if ( !$allow_classes ) {
80 my $dump = partial_dump($value);
81 return
82 "A plain scalar ($dump) will never pass an $type check (wants $class)";
83 }
84 }
85
86 my $got = blessed $value;
87 $got ||= $value;
88
89 return "The $got class is not a subclass of the $class class";
90 };
91 }
92
93 return sub { $generator->( undef, @_ ) };
94}
95## use critic
96
971;
98
99# ABSTRACT: Provides a common implementation for Specio::Constraint::AnyIsa and Specio::Constraint::ObjectIsa
100
101__END__