File Coverage

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


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