File Coverage

blib/lib/Specio/Registry.pm
Criterion Covered Total %
statement 25 25 100.0
branch 5 6 83.3
condition 4 7 57.1
subroutine 7 7 100.0
pod 0 3 0.0
total 41 48 85.4


line stmt bran cond sub pod time code
1             package Specio::Registry;
2              
3 29     29   232 use strict;
  29         59  
  29         904  
4 29     29   156 use warnings;
  29         58  
  29         779  
5              
6 29     29   152 use parent 'Exporter';
  29         50  
  29         211  
7              
8             our $VERSION = '0.47';
9              
10 29     29   2067 use Carp qw( confess croak );
  29         60  
  29         8045  
11              
12             our @EXPORT_OK
13             = qw( exportable_types_for_package internal_types_for_package register );
14              
15             my %Registry;
16              
17             sub register {
18 3108 50 33 3108 0 12173 confess
19             'register requires three or four arguments (package, name, type, [exportable])'
20             unless @_ == 3 || @_ == 4;
21              
22 3108         4982 my $package = shift;
23 3108         4117 my $name = shift;
24 3108         3955 my $type = shift;
25 3108         4198 my $exportable = shift;
26              
27             croak "The $package package already has a type named $name"
28 3108 100       7246 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 3107         6294 $Registry{$package}{internal}{$name} = $type;
36 3107 100       5952 $Registry{$package}{exportable}{$name} = $type
37             if $exportable;
38              
39 3107         6976 return;
40             }
41              
42             sub exportable_types_for_package {
43 169     169 0 312 my $package = shift;
44              
45 169   50     798 return $Registry{$package}{exportable} ||= {};
46             }
47              
48             sub internal_types_for_package {
49 273     273 0 530 my $package = shift;
50              
51 273   100     1972 return $Registry{$package}{internal} ||= {};
52             }
53              
54             1;
55              
56             # ABSTRACT: Implements the per-package type registry
57              
58             __END__
59              
60             =pod
61              
62             =encoding UTF-8
63              
64             =head1 NAME
65              
66             Specio::Registry - Implements the per-package type registry
67              
68             =head1 VERSION
69              
70             version 0.47
71              
72             =head1 DESCRIPTION
73              
74             There's nothing public here.
75              
76             =for Pod::Coverage .*
77              
78             =head1 SUPPORT
79              
80             Bugs may be submitted at L<https://github.com/houseabsolute/Specio/issues>.
81              
82             I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
83              
84             =head1 SOURCE
85              
86             The source code repository for Specio can be found at L<https://github.com/houseabsolute/Specio>.
87              
88             =head1 AUTHOR
89              
90             Dave Rolsky <autarch@urth.org>
91              
92             =head1 COPYRIGHT AND LICENSE
93              
94             This software is Copyright (c) 2012 - 2021 by Dave Rolsky.
95              
96             This is free software, licensed under:
97              
98             The Artistic License 2.0 (GPL Compatible)
99              
100             The full text of the license can be found in the
101             F<LICENSE> file included with this distribution.
102              
103             =cut