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 28     28   168 use strict;
  28         49  
  28         828  
4 28     28   127 use warnings;
  28         48  
  28         765  
5              
6 28     28   129 use parent 'Exporter';
  28         41  
  28         151  
7              
8             our $VERSION = '0.46';
9              
10 28     28   1971 use Carp qw( confess croak );
  28         55  
  28         6763  
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 2924 50 33 2924 0 10137 confess
19             'register requires three or four arguments (package, name, type, [exportable])'
20             unless @_ == 3 || @_ == 4;
21              
22 2924         4003 my $package = shift;
23 2924         3442 my $name = shift;
24 2924         3334 my $type = shift;
25 2924         3378 my $exportable = shift;
26              
27             croak "The $package package already has a type named $name"
28 2924 100       5752 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 2923         5189 $Registry{$package}{internal}{$name} = $type;
36 2923 100       4963 $Registry{$package}{exportable}{$name} = $type
37             if $exportable;
38              
39 2923         5836 return;
40             }
41              
42             sub exportable_types_for_package {
43 160     160 0 260 my $package = shift;
44              
45 160   50     629 return $Registry{$package}{exportable} ||= {};
46             }
47              
48             sub internal_types_for_package {
49 257     257 0 451 my $package = shift;
50              
51 257   100     1678 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.46
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 - 2020 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