← 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:04 2021

Filename/usr/local/lib/perl5/site_perl/Specio/Helpers.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSpecio::Helpers::::BEGIN@12Specio::Helpers::BEGIN@12
0000s0sSpecio::Helpers::::BEGIN@3Specio::Helpers::BEGIN@3
0000s0sSpecio::Helpers::::BEGIN@4Specio::Helpers::BEGIN@4
0000s0sSpecio::Helpers::::BEGIN@55Specio::Helpers::BEGIN@55
0000s0sSpecio::Helpers::::BEGIN@56Specio::Helpers::BEGIN@56
0000s0sSpecio::Helpers::::BEGIN@6Specio::Helpers::BEGIN@6
0000s0sSpecio::Helpers::::BEGIN@7Specio::Helpers::BEGIN@7
0000s0sSpecio::Helpers::::BEGIN@8Specio::Helpers::BEGIN@8
0000s0sSpecio::Helpers::::BEGIN@80Specio::Helpers::BEGIN@80
0000s0sSpecio::Helpers::::BEGIN@94Specio::Helpers::BEGIN@94
0000s0sSpecio::Helpers::::_STRINGSpecio::Helpers::_STRING
0000s0sSpecio::Helpers::::_STRINGLIKESpecio::Helpers::_STRINGLIKE
0000s0sSpecio::Helpers::::__ANON__[:51]Specio::Helpers::__ANON__[:51]
0000s0sSpecio::Helpers::::install_t_subSpecio::Helpers::install_t_sub
0000s0sSpecio::Helpers::::is_class_loadedSpecio::Helpers::is_class_loaded
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Specio::Helpers;
2
3use strict;
4use warnings;
5
6use Carp qw( croak );
7use Exporter 'import';
8use overload ();
9
10our $VERSION = '0.47';
11
12use Scalar::Util qw( blessed );
13
14our @EXPORT_OK = qw( install_t_sub is_class_loaded perlstring _STRINGLIKE );
15
16sub install_t_sub {
17
18 # Specio::DeclaredAt use Specio::OO, which in turn uses
19 # Specio::Helpers. If we load this with "use" we get a cirular require and
20 # a big mess.
21 require Specio::DeclaredAt;
22
23 my $caller = shift;
24 my $types = shift;
25
26 # XXX - check to see if their t() is something else entirely?
27 return if $caller->can('t');
28
29 my $t = sub {
30 my $name = shift;
31
32 croak 'The t subroutine requires a single non-empty string argument'
33 unless _STRINGLIKE($name);
34
35 croak "There is no type named $name available for the $caller package"
36 unless exists $types->{$name};
37
38 my $found = $types->{$name};
39
40 return $found unless @_;
41
42 my %p = @_;
43
44 croak 'Cannot parameterize a non-parameterizable type'
45 unless $found->can('parameterize');
46
47 return $found->parameterize(
48 declared_at => Specio::DeclaredAt->new_from_caller(1),
49 %p,
50 );
51 };
52
53 {
54 ## no critic (TestingAndDebugging::ProhibitNoStrict)
55 no strict 'refs';
56 no warnings 'redefine';
57 *{ $caller . '::t' } = $t;
58 }
59
60 return;
61}
62
63## no critic (Subroutines::ProhibitSubroutinePrototypes, Subroutines::ProhibitExplicitReturnUndef)
64sub _STRINGLIKE ($) {
65 return $_[0] if _STRING( $_[0] );
66
67 return $_[0]
68 if blessed $_[0]
69 && overload::Method( $_[0], q{""} )
70 && length "$_[0]";
71
72 return undef;
73}
74
75# Borrowed from Params::Util
76sub _STRING ($) {
77 return defined $_[0] && !ref $_[0] && length( $_[0] ) ? $_[0] : undef;
78}
79
80BEGIN {
81 if ( $] >= 5.010 && eval { require XString; 1 } ) {
82 *perlstring = \&XString::perlstring;
83 }
84 else {
85 require B;
86 *perlstring = \&B::perlstring;
87 }
88}
89
90# Borrowed from Types::Standard
91sub is_class_loaded {
92 my $stash = do {
93 ## no critic (TestingAndDebugging::ProhibitNoStrict)
94 no strict 'refs';
95 \%{ $_[0] . '::' };
96 };
97
98 return 1 if exists $stash->{ISA};
99 return 1 if exists $stash->{VERSION};
100
101 foreach my $globref ( values %{$stash} ) {
102 return 1
103 if ref \$globref eq 'GLOB'
104 ? *{$globref}{CODE}
105 : ref $globref; # const or sub ref
106 }
107
108 return 0;
109}
110
1111;
112
113# ABSTRACT: Helper subs for the Specio distro
114
115__END__