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   29010 use 5.010001;
  40         202  
4 40     40   268 use strict;
  40         117  
  40         946  
5 40     40   244 use warnings;
  40         122  
  40         976  
6 40     40   249 use Readonly;
  40         134  
  40         2096  
7              
8 40     40   332 use Perl::Critic::Utils qw{ :booleans :severities :classification :ppi };
  40         126  
  40         2156  
9 40     40   16485 use parent 'Perl::Critic::Policy';
  40         134  
  40         268  
10              
11             our $VERSION = '1.146';
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 1602 sub supported_parameters { return () }
21 78     78 1 401 sub default_severity { return $SEVERITY_HIGHEST }
22 92     92 1 382 sub default_themes { return qw( core pbp bugs ) }
23 38     38 1 120 sub applies_to { return 'PPI::Token::Word' }
24              
25             #-----------------------------------------------------------------------------
26              
27             sub violates {
28 379     379 1 750 my ($self, $elem, undef) = @_;
29              
30 379 100       724 return if $elem->content() ne 'bless';
31 12 100       63 return if ! is_function_call($elem);
32              
33 10 100       29 if( scalar parse_arg_list($elem) == 1 ) {
34 4         36 return $self->violation( $DESC, $EXPL, $elem );
35             }
36 6         24 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 :