File Coverage

blib/lib/Perl/Critic/Policy/ClassHierarchies/ProhibitOneArgBless.pm
Criterion Covered Total %
statement 27 27 100.0
branch 6 6 100.0
condition n/a
subroutine 11 11 100.0
pod 4 5 80.0
total 48 49 97.9


line stmt bran cond sub pod time code
1             package Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless;
2              
3 40     40   27639 use 5.010001;
  40         254  
4 40     40   271 use strict;
  40         131  
  40         865  
5 40     40   240 use warnings;
  40         153  
  40         932  
6 40     40   266 use Readonly;
  40         139  
  40         2071  
7              
8 40     40   310 use Perl::Critic::Utils qw{ :booleans :severities :classification :ppi };
  40         132  
  40         2234  
9 40     40   15877 use parent 'Perl::Critic::Policy';
  40         128  
  40         295  
10              
11             our $VERSION = '1.148';
12              
13             #-----------------------------------------------------------------------------
14              
15             Readonly::Scalar my $DESC => q{One-argument "bless" used};
16             Readonly::Scalar my $EXPL => [ 365 ];
17              
18             #-----------------------------------------------------------------------------
19              
20 91     91 0 1678 sub supported_parameters { return () }
21 78     78 1 401 sub default_severity { return $SEVERITY_HIGHEST }
22 92     92 1 356 sub default_themes { return qw( core pbp bugs ) }
23 38     38 1 118 sub applies_to { return 'PPI::Token::Word' }
24              
25             #-----------------------------------------------------------------------------
26              
27             sub violates {
28 379     379 1 757 my ($self, $elem, undef) = @_;
29              
30 379 100       738 return if $elem->content() ne 'bless';
31 12 100       66 return if ! is_function_call($elem);
32              
33 10 100       32 if( scalar parse_arg_list($elem) == 1 ) {
34 4         33 return $self->violation( $DESC, $EXPL, $elem );
35             }
36 6         22 return; #ok!
37             }
38              
39             1;
40              
41             #-----------------------------------------------------------------------------
42              
43             __END__
44              
45             =pod
46              
47             =head1 NAME
48              
49             Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless - Write C<bless {}, $class;> instead of just C<bless {};>.
50              
51              
52             =head1 AFFILIATION
53              
54             This Policy is part of the core L<Perl::Critic|Perl::Critic>
55             distribution.
56              
57              
58             =head1 DESCRIPTION
59              
60             Always use the two-argument form of C<bless> because it allows
61             subclasses to inherit your constructor.
62              
63             sub new {
64             my $class = shift;
65             my $self = bless {}; # not ok
66             my $self = bless {}, $class; # ok
67             return $self;
68             }
69              
70              
71             =head1 CONFIGURATION
72              
73             This Policy is not configurable except for the standard options.
74              
75              
76             =head1 AUTHOR
77              
78             Jeffrey Ryan Thalhammer <jeff@imaginative-software.com>
79              
80             =head1 COPYRIGHT
81              
82             Copyright (c) 2005-2011 Imaginative Software Systems. All rights reserved.
83              
84             This program is free software; you can redistribute it and/or modify
85             it under the same terms as Perl itself.
86              
87             =cut
88              
89             # Local Variables:
90             # mode: cperl
91             # cperl-indent-level: 4
92             # fill-column: 78
93             # indent-tabs-mode: nil
94             # c-indentation-style: bsd
95             # End:
96             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :