File Coverage

blib/lib/MooX/Private/Attribute.pm
Criterion Covered Total %
statement 19 19 100.0
branch 3 4 75.0
condition n/a
subroutine 5 5 100.0
pod n/a
total 27 28 96.4


line stmt bran cond sub pod time code
1             package MooX::Private::Attribute;
2 1     1   14276 use strict;
  1         2  
  1         29  
3 1     1   4 use warnings;
  1         2  
  1         23  
4 1     1   470 use MooX::ReturnModifiers;
  1         483  
  1         186  
5             our $VERSION = 0.01;
6              
7             sub import {
8 1     1   9 my $target = caller;
9 1         5 my %modifiers = return_modifiers( $target, [qw/before around/] );
10             $modifiers{around}->(
11             'has',
12             sub {
13 1     1   2537 my ( $orig, $attr, %opts ) = @_;
14 1         3 my $private = delete $opts{private};
15 1         5 $orig->( $attr, %opts );
16             $modifiers{before}->(
17             $attr,
18             sub {
19 5         7165 my $private_caller = caller(1);
20 5 100       67 if ( $private_caller ne $target ) {
21 2         18 die
22             "cannot call private attribute $attr from $private_caller";
23             }
24             }
25 1 50       22038 ) if $private;
26             }
27 1         32 );
28             }
29              
30             1;
31              
32             __END__
33              
34             =head1 NAME
35              
36             MooX::Private::Attribute - private attributes
37              
38             =head1 VERSION
39              
40             Version 0.01
41              
42             =cut
43              
44             =head1 SYNOPSIS
45              
46             package Lays;
47              
48             use Moo;
49             use MooX::Private::Attribute;
50              
51             has size => (
52             is => 'ro',
53             private => 1
54             );
55              
56             has flavour => (
57             is => 'ro',
58             private => 1
59             );
60              
61             sub bag {
62             return {
63             size => $_[0]->size,
64             flavour => $_[0]->flavour
65             }
66             }
67              
68             ....
69              
70             my $salt = Lays->new(
71             size => q|οικογένεια|,
72             flavour => q|τυρί & κρεμμύδι|
73             );
74              
75             $salt->bag # works
76             $salt->size # errors
77             $salt->flavour # errors
78              
79             =head1 SUBROUTINES/METHODS
80              
81             =head2 import
82              
83             call import method.
84              
85             $obj->import()
86              
87             =head1 AUTHOR
88              
89             LNATION, C<< <email at lnation.org> >>
90              
91             =head1 BUGS
92              
93             Please report any bugs or feature requests to C<bug-moox::private::attribute at rt.cpan.org>, or through
94             the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=MooX-Private-Attribute>. I will be notified, and then you'll
95             automatically be notified of progress on your bug as I make changes.
96              
97             =head1 SUPPORT
98              
99             You can find documentation for this module with the perldoc command.
100              
101             perldoc MooX::Private::Attribute
102              
103             You can also look for information at:
104              
105             =over 4
106              
107             =item * RT: CPAN's request tracker (report bugs here)
108              
109             L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=MooX-Private-Attribute>
110              
111             =item * AnnoCPAN: Annotated CPAN documentation
112              
113             L<http://annocpan.org/dist/MooX-Private-Attribute>
114              
115             =item * CPAN Ratings
116              
117             L<https://cpanratings.perl.org/d/MooX-Private-Attribute>
118              
119             =item * Search CPAN
120              
121             L<https://metacpan.org/release/MooX-Private-Attribute>
122              
123             =back
124              
125             =head1 ACKNOWLEDGEMENTS
126              
127             =head1 LICENSE AND COPYRIGHT
128              
129             This software is Copyright (c) 2020 by LNATION.
130              
131             This is free software, licensed under:
132              
133             The Artistic License 2.0 (GPL Compatible)
134              
135             =cut
136              
137