File Coverage

blib/lib/Perl/Critic/Policy/PreferredModules.pm
Criterion Covered Total %
statement 76 79 96.2
branch 15 22 68.1
condition 5 10 50.0
subroutine 15 15 100.0
pod 2 3 66.6
total 113 129 87.6


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::PreferredModules;
2              
3 2     2   295628 use strict;
  2         12  
  2         67  
4 2     2   12 use warnings;
  2         5  
  2         62  
5              
6 2     2   433 use parent 'Perl::Critic::Policy';
  2         359  
  2         16  
7              
8 2     2   387941 use Perl::Critic::Utils qw{ :severities :classification :ppi $SEVERITY_MEDIUM $TRUE $FALSE };
  2         6  
  2         179  
9              
10 2     2   893 use Perl::Critic::Exception::AggregateConfiguration ();
  2         6  
  2         37  
11 2     2   1198 use Perl::Critic::Exception::Configuration::Generic ();
  2         1499  
  2         49  
12              
13 2     2   1052 use Config::INI::Reader ();
  2         60417  
  2         145  
14              
15             sub supported_parameters {
16             return (
17             {
18 6     6 0 1527319 name => 'config',
19             description => 'Config::INI file listing recommendations.',
20             behavior => 'string',
21             },
22             );
23             }
24              
25 2     2   24 use constant default_severity => $SEVERITY_MEDIUM;
  2         4  
  2         190  
26 2     2   17 use constant applies_to => 'PPI::Statement::Include';
  2         6  
  2         99  
27              
28 2     2   12 use constant optional_config_attributes => qw{ prefer reason };
  2         5  
  2         1156  
29              
30             sub initialize_if_enabled {
31 5     5 1 1348407 my ( $self, $config ) = @_;
32              
33 5   50     36 my $cfg_file = $config->get('config') // '';
34 5         78 $cfg_file =~ s{^~}{$ENV{HOME}};
35              
36 5         27 $self->{_is_enabled} = !! $self->_parse_config($cfg_file);
37              
38 3         15 return $TRUE;
39             }
40              
41             sub _add_exception {
42 2     2   8 my ( $self, $msg ) = @_;
43              
44 2   50     8 $msg //= q[Unknown Error];
45              
46 2         8 $msg = __PACKAGE__ . ' ' . $msg;
47              
48 2         17 my $errors = Perl::Critic::Exception::AggregateConfiguration->new();
49              
50 2         2275 $errors->add_exception( Perl::Critic::Exception::Configuration::Generic->throw( message => $msg ) );
51              
52 0         0 return;
53             }
54              
55             sub _parse_config {
56 5     5   22 my ( $self, $cfg_file ) = @_;
57              
58 5 50       66 if ( !length $cfg_file ) {
59 0         0 return;
60             }
61              
62 5 100       75 if ( !-e $cfg_file ) {
63 1         336 return $self->_add_exception(qq[config file '$cfg_file' does not exist.]);
64             }
65              
66 4 50 33     1653 return unless $cfg_file && -e $cfg_file;
67              
68             # slurp the file rather than using `read_file` for compat with Test::MockFile
69 4         1055 my $content;
70             {
71 4         79 local $/;
  4         27  
72 4 50       28 open my $fh, '<', $cfg_file or return;
73 4         1241 $content = <$fh>;
74             }
75              
76 4         286 my $preferred_cfg;
77 4 50       10 eval { $preferred_cfg = Config::INI::Reader->read_string($content); 1 } or do {
  4         58  
  4         3933  
78 0         0 return $self->_add_exception(qq[Invalid configuration file $cfg_file]);
79             };
80              
81 4         18 my %valid_opts = map { $_ => 1 } optional_config_attributes();
  8         42  
82              
83 4         27 foreach my $pkg ( keys %$preferred_cfg ) {
84 10         23 my $setup = $preferred_cfg->{$pkg};
85              
86 10         32 my @has_opts = keys %$setup;
87 10         27 foreach my $opt (@has_opts) {
88 10 100       35 next if $valid_opts{$opt};
89 1         9 $self->_add_exception("Invalid configuration - Package '$pkg' is using an unknown setting '$opt'");
90             }
91             }
92              
93 3         22 $self->{_cfg_preferred_modules} = $preferred_cfg;
94              
95 3         16 return 1;
96             }
97              
98             sub violates {
99 7     7 1 30009 my ( $self, $elem ) = @_;
100              
101 7 50       24 return () unless $self->{_is_enabled};
102 7 50       25 return () unless $elem;
103              
104 7         26 my $module = $elem->module;
105              
106 7 50       238 return () unless defined $module;
107 7 100       29 return () unless my $setup = $self->{_cfg_preferred_modules}->{$module};
108              
109 5         22 my $desc = qq[Using module $module is not recommended];
110 5   66     21 my $expl = $setup->{reason} // $desc;
111              
112 5 100       17 if ( my $prefer = $setup->{prefer} ) {
113 4         13 $desc = "Prefer using module module $prefer over $module";
114             }
115              
116 5         27 return $self->violation( $desc, $expl, $elem );
117             }
118              
119             1;
120              
121             __END__
122              
123             =pod
124              
125             =encoding UTF-8
126              
127             =head1 NAME
128              
129             Perl::Critic::Policy::PreferredModules
130              
131             =head1 VERSION
132              
133             version 0.003
134              
135             =head1 DESCRIPTION
136              
137             Every project has its own rules for preferring specific packages over others.
138              
139             This Policy tries to be `un-opinionated` and let the user provide a module
140             preferences with an explanation and/or suggested alternative.
141              
142             =head1 NAME
143              
144             Perl::Critic::Policy::PreferredModules - Provide custom package recommendations
145              
146             =head1 MODULES
147              
148             =head1 CONFIGURATION
149              
150             To use L<Perl::Critic::Policy::PreferredModules> you have first to enable it in your
151             F<.perlcriticrc> file by providing a F<preferred_modules.ini> configuration file:
152              
153             [PreferredModules]
154             config = /path/to/preferred_modules.ini
155             # you can also use '~' in the path for $HOME
156             #config = ~/.preferred_modules
157              
158             The F<preferred_modules.ini> file is using the L<Config::INI> format and can looks like this
159              
160             [Do::Not::Use]
161             prefer = Another::Package
162             reason = "Please use Another::Package rather than Do::Not::Use"
163              
164             [Avoid::Using::This]
165             [And::Also::That]
166              
167             [No:Reason]
168             prefer=A::Better:Module
169            
170             [Only::Reason]
171             reason="If you use this module, a puppy might die."
172              
173             =head1 SEE ALSO
174              
175             L<Perl::Critic>
176              
177             =head1 AUTHOR
178              
179             Nicolas R <atoomic@cpan.org>
180              
181             =head1 COPYRIGHT AND LICENSE
182              
183             This software is copyright (c) 2022 by cPanel, L.L.C.
184              
185             This is free software; you can redistribute it and/or modify it under
186             the same terms as the Perl 5 programming language system itself.
187              
188             =cut