← 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/Registry.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSpecio::Registry::::BEGIN@10Specio::Registry::BEGIN@10
0000s0sSpecio::Registry::::BEGIN@3Specio::Registry::BEGIN@3
0000s0sSpecio::Registry::::BEGIN@4Specio::Registry::BEGIN@4
0000s0sSpecio::Registry::::BEGIN@6Specio::Registry::BEGIN@6
0000s0sSpecio::Registry::::exportable_types_for_packageSpecio::Registry::exportable_types_for_package
0000s0sSpecio::Registry::::internal_types_for_packageSpecio::Registry::internal_types_for_package
0000s0sSpecio::Registry::::registerSpecio::Registry::register
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Specio::Registry;
2
3use strict;
4use warnings;
5
6use parent 'Exporter';
7
8our $VERSION = '0.47';
9
10use Carp qw( confess croak );
11
12our @EXPORT_OK
13 = qw( exportable_types_for_package internal_types_for_package register );
14
15my %Registry;
16
17sub register {
18 confess
19 'register requires three or four arguments (package, name, type, [exportable])'
20 unless @_ == 3 || @_ == 4;
21
22 my $package = shift;
23 my $name = shift;
24 my $type = shift;
25 my $exportable = shift;
26
27 croak "The $package package already has a type named $name"
28 if $Registry{$package}{internal}{$name};
29
30 # This is structured so that we can always return a _reference_ for
31 # *_types_for_package. This means that the generated t sub sees any
32 # changes to the registry as they happen. This is important inside a
33 # package that is declaring new types. It needs to be able to see types it
34 # has declared.
35 $Registry{$package}{internal}{$name} = $type;
36 $Registry{$package}{exportable}{$name} = $type
37 if $exportable;
38
39 return;
40}
41
42sub exportable_types_for_package {
43 my $package = shift;
44
45 return $Registry{$package}{exportable} ||= {};
46}
47
48sub internal_types_for_package {
49 my $package = shift;
50
51 return $Registry{$package}{internal} ||= {};
52}
53
541;
55
56# ABSTRACT: Implements the per-package type registry
57
58__END__