File Coverage

blib/lib/MooX/StrictHas.pm
Criterion Covered Total %
statement 27 27 100.0
branch 7 10 70.0
condition n/a
subroutine 13 13 100.0
pod n/a
total 47 50 94.0


line stmt bran cond sub pod time code
1             package MooX::StrictHas;
2              
3             our $VERSION = '0.02';
4              
5             # this bit would be MooX::Utils but without initial _ on func name
6 1     1   13792 use strict;
  1         2  
  1         27  
7 1     1   5 use warnings;
  1         2  
  1         22  
8 1     1   5 use Moo ();
  1         5  
  1         11  
9 1     1   463 use Moo::Role ();
  1         8398  
  1         26  
10 1     1   7 use Carp qw(croak);
  1         3  
  1         310  
11             #use base qw(Exporter);
12             #our @EXPORT = qw(override_function);
13             sub _override_function {
14 4     4   11 my ($target, $name, $func) = @_;
15 4 50       37 my $orig = $target->can($name) or croak "Override '$target\::$name': not found";
16 4 50       15 my $install_tracked = Moo::Role->is_role($target) ? \&Moo::Role::_install_tracked : \&Moo::_install_tracked;
17 4     4   126 $install_tracked->($target, $name, sub { $func->($orig, @_) });
  4     4   267  
        4      
        4      
        4      
18             }
19             # end MooX::Utils;
20              
21             my %ATTR2MESSAGE = (
22             auto_deref => q{just dereference in your using code},
23             lazy_build => q{Use "is => 'lazy'" instead"},
24             );
25             sub import {
26 4     4   3243 my $target = scalar caller;
27             _override_function($target, 'has', sub {
28 4     4   14 my ($orig, $namespec, %opts) = @_;
29 4 50       12 $namespec = "[@$namespec]" if ref $namespec;
30 4         7 my @messages;
31             push @messages, exists($opts{$_})
32             ? "$_ detected on $namespec: $ATTR2MESSAGE{$_}"
33             : ()
34 4 100       40 for sort keys %ATTR2MESSAGE;
35 4 100       557 croak join "\n", @messages if @messages;
36 4         36 });
37             }
38              
39             =head1 NAME
40              
41             MooX::StrictHas - Forbid "has" attributes lazy_build and auto_deref
42              
43             =begin markdown
44              
45             # PROJECT STATUS
46              
47             | OS | Build status |
48             |:-------:|--------------:|
49             | Linux | [![Build Status](https://travis-ci.com/mohawk2/moox-stricthas.svg?branch=master)](https://travis-ci.org/mohawk2/moox-stricthas) |
50              
51             [![CPAN version](https://badge.fury.io/pl/moox-stricthas.svg)](https://metacpan.org/pod/MooX::StrictHas) [![Coverage Status](https://coveralls.io/repos/github/mohawk2/moox-stricthas/badge.svg?branch=master)](https://coveralls.io/github/mohawk2/moox-stricthas?branch=master)
52              
53             =end markdown
54              
55             =head1 SYNOPSIS
56              
57             package MyMod;
58             use Moo;
59             use MooX::StrictHas;
60             has attr => (
61             is => 'ro',
62             auto_deref => 1, # blows up, not implemented in Moo
63             );
64             has attr2 => (
65             is => 'ro',
66             lazy_build => 1, # blows up, not implemented in Moo
67             );
68              
69             =head1 DESCRIPTION
70              
71             This is a L extension, intended to aid those porting modules from
72             L to Moo. It forbids two attributes for L, which Moo
73             does not implement, but silently accepts:
74              
75             =over
76              
77             =item auto_deref
78              
79             This is not considered best practice - just dereference in your using code.
80              
81             =item lazy_build
82              
83             Use C 'lazy'> instead.
84              
85             =back
86              
87             =head1 AUTHOR
88              
89             Ed J
90              
91             =head1 LICENCE
92              
93             The same terms as Perl itself.
94              
95             =cut
96              
97             1;