ext/B/B/Lint.pm

   1 package B::Lint;
   2
   3 our $VERSION = '1.09';    ## no critic
   4
   5 =head1 NAME
   6
   7 B::Lint - Perl lint
   8
   9 =head1 SYNOPSIS
  10
  11 perl -MO=Lint[,OPTIONS] foo.pl
  12
  13 =head1 DESCRIPTION
  14
  15 The B::Lint module is equivalent to an extended version of the B<-w>
  16 option of B<perl>. It is named after the program F<lint> which carries
  17 out a similar process for C programs.
  18
  19 =head1 OPTIONS AND LINT CHECKS
  20
  21 Option words are separated by commas (not whitespace) and follow the
  22 usual conventions of compiler backend options. Following any options
  23 (indicated by a leading B<->) come lint check arguments. Each such
  24 argument (apart from the special B<all> and B<none> options) is a
  25 word representing one possible lint check (turning on that check) or
  26 is B<no-foo> (turning off that check). Before processing the check
  27 arguments, a standard list of checks is turned on. Later options
  28 override earlier ones. Available options are:
  29
  30 =over 8
  31
  32 =item B<magic-diamond>
  33
  34 Produces a warning whenever the magic C<E<lt>E<gt>> readline is
  35 used. Internally it uses perl's two-argument open which itself treats
  36 filenames with special characters specially. This could allow
  37 interestingly named files to have unexpected effects when reading.
  38
  39   % touch 'rm *|'
  40   % perl -pe 1
  41
  42 The above creates a file named C<rm *|>. When perl opens it with
  43 C<E<lt>E<gt>> it actually executes the shell program C<rm *>. This
  44 makes C<E<lt>E<gt>> dangerous to use carelessly.
  45
  46 =item B<context>
  47
  48 Produces a warning whenever an array is used in an implicit scalar
  49 context. For example, both of the lines
  50
  51     $foo = length(@bar);
  52     $foo = @bar;
  53
  54 will elicit a warning. Using an explicit B<scalar()> silences the
  55 warning. For example,
  56
  57     $foo = scalar(@bar);
  58
  59 =item B<implicit-read> and B<implicit-write>
  60
  61 These options produce a warning whenever an operation implicitly
  62 reads or (respectively) writes to one of Perl's special variables.
  63 For example, B<implicit-read> will warn about these:
  64
  65     /foo/;
  66
  67 and B<implicit-write> will warn about these:
  68
  69     s/foo/bar/;
  70
  71 Both B<implicit-read> and B<implicit-write> warn about this:
  72
  73     for (@a) { ... }
  74
  75 =item B<bare-subs>
  76
  77 This option warns whenever a bareword is implicitly quoted, but is also
  78 the name of a subroutine in the current package. Typical mistakes that it will
  79 trap are:
  80
  81     use constant foo => 'bar';
  82     @a = ( foo => 1 );
  83     $b{foo} = 2;
  84
  85 Neither of these will do what a naive user would expect.
  86
  87 =item B<dollar-underscore>
  88
  89 This option warns whenever C<$_> is used either explicitly anywhere or
  90 as the implicit argument of a B<print> statement.
  91
  92 =item B<private-names>
  93
  94 This option warns on each use of any variable, subroutine or
  95 method name that lives in a non-current package but begins with
  96 an underscore ("_"). Warnings aren't issued for the special case
  97 of the single character name "_" by itself (e.g. C<$_> and C<@_>).
  98
  99 =item B<undefined-subs>
 100
 101 This option warns whenever an undefined subroutine is invoked.
 102 This option will only catch explicitly invoked subroutines such
 103 as C<foo()> and not indirect invocations such as C<&$subref()>
 104 or C<$obj-E<gt>meth()>. Note that some programs or modules delay
 105 definition of subs until runtime by means of the AUTOLOAD
 106 mechanism.
 107
 108 =item B<regexp-variables>
 109
 110 This option warns whenever one of the regexp variables C<$`>, C<$&> or C<$'>
 111 is used. Any occurrence of any of these variables in your
 112 program can slow your whole program down. See L<perlre> for
 113 details.
 114
 115 =item B<all>
 116
 117 Turn all warnings on.
 118
 119 =item B<none>
 120
 121 Turn all warnings off.
 122
 123 =back
 124
 125 =head1 NON LINT-CHECK OPTIONS
 126
 127 =over 8
 128
 129 =item B<-u Package>
 130
 131 Normally, Lint only checks the main code of the program together
 132 with all subs defined in package main. The B<-u> option lets you
 133 include other package names whose subs are then checked by Lint.
 134
 135 =back
 136
 137 =head1 EXTENDING LINT
 138
 139 Lint can be extended by with plugins. Lint uses L<Module::Pluggable>
 140 to find available plugins. Plugins are expected but not required to
 141 inform Lint of which checks they are adding.
 142
 143 The C<< B::Lint->register_plugin( MyPlugin => \@new_checks ) >> method
 144 adds the list of C<@new_checks> to the list of valid checks. If your
 145 module wasn't loaded by L<Module::Pluggable> then your class name is
 146 added to the list of plugins.
 147
 148 You must create a C<match( \%checks )> method in your plugin class or one
 149 of its parents. It will be called on every op as a regular method call
 150 with a hash ref of checks as its parameter.
 151
 152 The class methods C<< B::Lint->file >> and C<< B::Lint->line >> contain
 153 the current filename and line number.
 154
 155   package Sample;
 156   use B::Lint;
 157   B::Lint->register_plugin( Sample => [ 'good_taste' ] );
 158
 159   sub match {
 160       my ( $op, $checks_href ) = shift @_;
 161       if ( $checks_href->{good_taste} ) {
 162           ...
 163       }
 164   }
 165
 166 =head1 TODO
 167
 168 =over
 169
 170 =item while(<FH>) stomps $_
 171
 172 =item strict oo
 173
 174 =item unchecked system calls
 175
 176 =item more tests, validate against older perls
 177
 178 =back
 179
 180 =head1 BUGS
 181
 182 This is only a very preliminary version.
 183
 184 =head1 AUTHOR
 185
 186 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
 187
 188 =cut
 189
 190 use strict;
 191 use B qw( walkoptree_slow
 192     main_root main_cv walksymtable parents
 193     OPpOUR_INTRO
 194     OPf_WANT_VOID OPf_WANT_LIST OPf_WANT OPf_STACKED SVf_POK );
 195 use Carp 'carp';
 196
 197 # The current M::P doesn't know about .pmc files.
 198 use Module::Pluggable ( require => 1 );
 199
 200 use List::Util 'first';
 201 ## no critic Prototypes
 202 sub any (&@) { my $test = shift @_; $test->() and return 1 for @_; return 0 }
 203
 204 BEGIN {
 205
 206     # Import or create some constants from B. B doesn't provide
 207     # everything I need so some things like OPpCONST_BARE are defined
 208     # here.
 209     for my $sym ( qw( begin_av check_av init_av end_av ),
 210         [ 'OPpCONST_BARE' => 64 ] )
 211     {
 212         my $val;
 213         ( $sym, $val ) = @$sym if ref $sym;
 214
 215         if ( any { $sym eq $_ } @B::EXPORT_OK, @B::EXPORT ) {
 216             B->import($sym);
 217         }
 218         else {
 219             require constant;
 220             constant->import( $sym => $val );
 221         }
 222     }
 223 }
 224
 225 my $file     = "unknown";    # shadows current filename
 226 my $line     = 0;            # shadows current line number
 227 my $curstash = "main";       # shadows current stash
 228 my $curcv;                   # shadows current B::CV for pad lookups
 229
 230 sub file     {$file}
 231 sub line     {$line}
 232 sub curstash {$curstash}
 233 sub curcv    {$curcv}
 234
 235 # Lint checks
 236 my %check;
 237 my %implies_ok_context;
 238
 239 map( $implies_ok_context{$_}++,
 240     qw(scalar av2arylen aelem aslice helem hslice
 241         keys values hslice defined undef delete) );
 242
 243 # Lint checks turned on by default
 244 my @default_checks
 245     = qw(context magic_diamond undefined_subs regexp_variables);
 246
 247 my %valid_check;
 248
 249 # All valid checks
 250 for my $check (
 251     qw(context implicit_read implicit_write dollar_underscore
 252     private_names bare_subs undefined_subs regexp_variables
 253     magic_diamond )
 254     )
 255 {
 256     $valid_check{$check} = __PACKAGE__;
 257 }
 258
 259 # Debugging options
 260 my ($debug_op);
 261
 262 my %done_cv;           # used to mark which subs have already been linted
 263 my @extra_packages;    # Lint checks mainline code and all subs which are
 264                        # in main:: or in one of these packages.
 265
 266 sub warning {
 267     my $format = ( @_ < 2 ) ? "%s" : shift @_;
 268     warn sprintf( "$format at %s line %d\n", @_, $file, $line );
 269     return undef;      ## no critic undef
 270 }
 271
 272 # This gimme can't cope with context that's only determined
 273 # at runtime via dowantarray().
 274 sub gimme {
 275     my $op    = shift @_;
 276     my $flags = $op->flags;
 277     if ( $flags & OPf_WANT ) {
 278         return ( ( $flags & OPf_WANT ) == OPf_WANT_LIST ? 1 : 0 );
 279     }
 280     return undef;      ## no critic undef
 281 }
 282
 283 my @plugins = __PACKAGE__->plugins;
 284
 285 sub inside_grepmap {
 286
 287     # A boolean function to be used while inside a B::walkoptree_slow
 288     # call. If we are in the EXPR part of C<grep EXPR, ...> or C<grep
 289     # { EXPR } ...>, this returns true.
 290     return any { $_->name =~ m/\A(?:grep|map)/xms } @{ parents() };
 291 }
 292
 293 sub inside_foreach_modifier {
 294
 295     # TODO: use any()
 296
 297     # A boolean function to be used while inside a B::walkoptree_slow
 298     # call. If we are in the EXPR part of C<EXPR foreach ...> this
 299     # returns true.
 300     for my $ancestor ( @{ parents() } ) {
 301         next unless $ancestor->name eq 'leaveloop';
 302
 303         my $first = $ancestor->first;
 304         next unless $first->name eq 'enteriter';
 305
 306         next if $first->redoop->name =~ m/\A(?:next|db|set)state\z/xms;
 307
 308         return 1;
 309     }
 310     return 0;
 311 }
 312
 313 for (
 314     [qw[ B::PADOP::gv_harder gv padix]],
 315     [qw[ B::SVOP::sv_harder  sv targ]],
 316     [qw[ B::SVOP::gv_harder gv padix]]
 317     )
 318 {
 319
 320     # I'm generating some functions here because they're mostly
 321     # similar. It's all for compatibility with threaded
 322     # perl. Perhaps... this code should inspect $Config{usethreads}
 323     # and generate a *specific* function. I'm leaving it generic for
 324     # the moment.
 325     #
 326     # In threaded perl SVs and GVs aren't used directly in the optrees
 327     # like they are in non-threaded perls. The ops that would use a SV
 328     # or GV keep an index into the subroutine's scratchpad. I'm
 329     # currently ignoring $cv->DEPTH and that might be at my peril.
 330
 331     my ( $subname, $attr, $pad_attr ) = @$_;
 332     my $target = do {    ## no critic strict
 333         no strict 'refs';
 334         \*$subname;
 335     };
 336     *$target = sub {
 337         my ($op) = @_;
 338
 339         my $elt;
 340         if ( not $op->isa('B::PADOP') ) {
 341             $elt = $op->$attr;
 342         }
 343         return $elt if eval { $elt->isa('B::SV') };
 344
 345         my $ix         = $op->$pad_attr;
 346         my @entire_pad = $curcv->PADLIST->ARRAY;
 347         my @elts       = map +( $_->ARRAY )[$ix], @entire_pad;
 348         ($elt) = first {
 349             eval { $_->isa('B::SV') } ? $_ : ();
 350             }
 351             @elts[ 0, reverse 1 .. $#elts ];
 352         return $elt;
 353     };
 354 }
 355
 356 sub B::OP::lint {
 357     my ($op) = @_;
 358
 359     # This is a fallback ->lint for all the ops where I haven't
 360     # defined something more specific. Nothing happens here.
 361
 362     # Call all registered plugins
 363     my $m;
 364     $m = $_->can('match'), $op->$m( \%check ) for @plugins;
 365     return;
 366 }
 367
 368 sub B::COP::lint {
 369     my ($op) = @_;
 370
 371     # nextstate ops sit between statements. Whenever I see one I
 372     # update the current info on file, line, and stash. This code also
 373     # updates it when it sees a dbstate or setstate op. I have no idea
 374     # what those are but having seen them mentioned together in other
 375     # parts of the perl I think they're kind of equivalent.
 376     if ( $op->name =~ m/\A(?:next|db|set)state\z/ ) {
 377         $file     = $op->file;
 378         $line     = $op->line;
 379         $curstash = $op->stash->NAME;
 380     }
 381
 382     # Call all registered plugins
 383     my $m;
 384     $m = $_->can('match'), $op->$m( \%check ) for @plugins;
 385     return;
 386 }
 387
 388 sub B::UNOP::lint {
 389     my ($op) = @_;
 390
 391     my $opname = $op->name;
 392
 393 CONTEXT: {
 394
 395         # Check arrays and hashes in scalar or void context where
 396         # scalar() hasn't been used.
 397
 398         next
 399             unless $check{context}
 400             and $opname =~ m/\Arv2[ah]v\z/xms
 401             and not gimme($op);
 402
 403         my ( $parent, $gparent ) = @{ parents() }[ 0, 1 ];
 404         my $pname = $parent->name;
 405
 406         next if $implies_ok_context{$pname};
 407
 408         # Three special cases to deal with: "foreach (@foo)", "delete
 409         # $a{$b}", and "exists $a{$b}" null out the parent so we have to
 410         # check for a parent of pp_null and a grandparent of
 411         # pp_enteriter, pp_delete, pp_exists
 412
 413         next
 414             if $pname eq "null"
 415             and $gparent->name =~ m/\A(?:delete|enteriter|exists)\z/xms;
 416
 417         # our( @bar ); would also trigger this error so I exclude
 418         # that.
 419         next
 420             if $op->private & OPpOUR_INTRO
 421             and ( $op->flags & OPf_WANT ) == OPf_WANT_VOID;
 422
 423         warning 'Implicit scalar context for %s in %s',
 424             $opname eq "rv2av" ? "array" : "hash", $parent->desc;
 425     }
 426
 427 PRIVATE_NAMES: {
 428
 429         # Looks for calls to methods with names that begin with _ and
 430         # that aren't visible within the current package. Maybe this
 431         # should look at @ISA.
 432         next
 433             unless $check{private_names}
 434             and $opname =~ m/\Amethod/xms;
 435
 436         my $methop = $op->first;
 437         next unless $methop->name eq "const";
 438
 439         my $method = $methop->sv_harder->PV;
 440         next
 441             unless $method =~ m/\A_/xms
 442             and not defined &{"$curstash\::$method"};
 443
 444         warning q[Illegal reference to private method name '%s'], $method;
 445     }
 446
 447     # Call all registered plugins
 448     my $m;
 449     $m = $_->can('match'), $op->$m( \%check ) for @plugins;
 450     return;
 451 }
 452
 453 sub B::PMOP::lint {
 454     my ($op) = @_;
 455
 456 IMPLICIT_READ: {
 457
 458         # Look for /.../ that doesn't use =~ to bind to something.
 459         next
 460             unless $check{implicit_read}
 461             and $op->name eq "match"
 462             and not( $op->flags & OPf_STACKED
 463             or inside_grepmap() );
 464         warning 'Implicit match on $_';
 465     }
 466
 467 IMPLICIT_WRITE: {
 468
 469         # Look for s/.../.../ that doesn't use =~ to bind to
 470         # something.
 471         next
 472             unless $check{implicit_write}
 473             and $op->name eq "subst"
 474             and not $op->flags & OPf_STACKED;
 475         warning 'Implicit substitution on $_';
 476     }
 477
 478     # Call all registered plugins
 479     my $m;
 480     $m = $_->can('match'), $op->$m( \%check ) for @plugins;
 481     return;
 482 }
 483
 484 sub B::LOOP::lint {
 485     my ($op) = @_;
 486
 487 IMPLICIT_FOO: {
 488
 489         # Look for C<for ( ... )>.
 490         next
 491             unless ( $check{implicit_read} or $check{implicit_write} )
 492             and $op->name eq "enteriter";
 493
 494         my $last = $op->last;
 495         next
 496             unless $last->name         eq "gv"
 497             and $last->gv_harder->NAME eq "_"
 498             and $op->redoop->name =~ m/\A(?:next|db|set)state\z/xms;
 499
 500         warning 'Implicit use of $_ in foreach';
 501     }
 502
 503     # Call all registered plugins
 504     my $m;
 505     $m = $_->can('match'), $op->$m( \%check ) for @plugins;
 506     return;
 507 }
 508
 509 # In threaded vs non-threaded perls you'll find that threaded perls
 510 # use PADOP in place of SVOPs so they can do lookups into the
 511 # scratchpad to find things. I suppose this is so a optree can be
 512 # shared between threads and all symbol table muckery will just get
 513 # written to a scratchpad.
 514 *B::PADOP::lint = \&B::SVOP::lint;
 515
 516 sub B::SVOP::lint {
 517     my ($op) = @_;
 518
 519 MAGIC_DIAMOND: {
 520         next
 521             unless $check{magic_diamond}
 522             and parents()->[0]->name eq 'readline'
 523             and $op->gv_harder->NAME eq 'ARGV';
 524
 525         warning 'Use of <>';
 526     }
 527
 528 BARE_SUBS: {
 529         next
 530             unless $check{bare_subs}
 531             and $op->name eq 'const'
 532             and $op->private & OPpCONST_BARE;
 533
 534         my $sv = $op->sv_harder;
 535         next unless $sv->FLAGS & SVf_POK;
 536
 537         my $sub     = $sv->PV;
 538         my $subname = "$curstash\::$sub";
 539
 540         # I want to skip over things that were declared with the
 541         # constant pragma. Well... sometimes. Hmm. I want to ignore
 542         # C<<use constant FOO => ...>> but warn on C<<FOO => ...>>
 543         # later. The former is typical declaration syntax and the
 544         # latter would be an error.
 545         #
 546         # Skipping over both could be handled by looking if
 547         # $constant::declared{$subname} is true.
 548
 549         # Check that it's a function.
 550         next
 551             unless exists &{"$curstash\::$sub"};
 552
 553         warning q[Bare sub name '%s' interpreted as string], $sub;
 554     }
 555
 556 PRIVATE_NAMES: {
 557         next unless $check{private_names};
 558
 559         my $opname = $op->name;
 560         if ( $opname =~ m/\Agv(?:sv)?\z/xms ) {
 561
 562             # Looks for uses of variables and stuff that are named
 563             # private and we're not in the same package.
 564             my $gv   = $op->gv_harder;
 565             my $name = $gv->NAME;
 566             next
 567                 unless $name =~ m/\A_./xms
 568                 and $gv->STASH->NAME ne $curstash;
 569
 570             warning q[Illegal reference to private name '%s'], $name;
 571         }
 572         elsif ( $opname eq "method_named" ) {
 573             my $method = $op->sv_harder->PV;
 574             next unless $method =~ m/\A_./xms;
 575
 576             warning q[Illegal reference to private method name '%s'], $method;
 577         }
 578     }
 579
 580 DOLLAR_UNDERSCORE: {
 581
 582         # Warn on uses of $_ with a few exceptions. I'm not warning on
 583         # $_ inside grep, map, or statement modifer foreach because
 584         # they localize $_ and it'd be impossible to use these
 585         # features without getting warnings.
 586
 587         next
 588             unless $check{dollar_underscore}
 589             and $op->name            eq "gvsv"
 590             and $op->gv_harder->NAME eq "_"
 591             and not( inside_grepmap
 592             or inside_foreach_modifier );
 593
 594         warning 'Use of $_';
 595     }
 596
 597 REGEXP_VARIABLES: {
 598
 599         # Look for any uses of $`, $&, or $'.
 600         next
 601             unless $check{regexp_variables}
 602             and $op->name eq "gvsv";
 603
 604         my $name = $op->gv_harder->NAME;
 605         next unless $name =~ m/\A[\&\'\`]\z/xms;
 606
 607         warning 'Use of regexp variable $%s', $name;
 608     }
 609
 610 UNDEFINED_SUBS: {
 611
 612         # Look for calls to functions that either don't exist or don't
 613         # have a definition.
 614         next
 615             unless $check{undefined_subs}
 616             and $op->name       eq "gv"
 617             and $op->next->name eq "entersub";
 618
 619         my $gv      = $op->gv_harder;
 620         my $subname = $gv->STASH->NAME . "::" . $gv->NAME;
 621
 622         no strict 'refs';    ## no critic strict
 623         if ( not exists &$subname ) {
 624             $subname =~ s/\Amain:://;
 625             warning q[Nonexistant subroutine '%s' called], $subname;
 626         }
 627         elsif ( not defined &$subname ) {
 628             $subname =~ s/\A\&?main:://;
 629             warning q[Undefined subroutine '%s' called], $subname;
 630         }
 631     }
 632
 633     # Call all registered plugins
 634     my $m;
 635     $m = $_->can('match'), $op->$m( \%check ) for @plugins;
 636     return;
 637 }
 638
 639 sub B::GV::lintcv {
 640
 641     # Example: B::svref_2object( \ *A::Glob )->lintcv
 642
 643     my $gv = shift @_;
 644     my $cv = $gv->CV;
 645     return unless $cv->can('lintcv');
 646     $cv->lintcv;
 647     return;
 648 }
 649
 650 sub B::CV::lintcv {
 651
 652     # Example: B::svref_2object( \ &foo )->lintcv
 653
 654     # Write to the *global* $
 655     $curcv = shift @_;
 656
 657     #warn sprintf("lintcv: %s::%s (done=%d)\n",
 658     #            $gv->STASH->NAME, $gv->NAME, $done_cv{$$curcv});#debug
 659     return unless ref($curcv) and $$curcv and not $done_cv{$$curcv}++;
 660     my $root = $curcv->ROOT;
 661
 662     #warn "    root = $root (0x$$root)\n";#debug
 663     walkoptree_slow( $root, "lint" ) if $$root;
 664     return;
 665 }
 666
 667 sub do_lint {
 668     my %search_pack;
 669
 670     # Copy to the global $curcv for use in pad lookups.
 671     $curcv = main_cv;
 672     walkoptree_slow( main_root, "lint" ) if ${ main_root() };
 673
 674     # Do all the miscellaneous non-sub blocks.
 675     for my $av ( begin_av, init_av, check_av, end_av ) {
 676         next unless eval { $av->isa('B::AV') };
 677         for my $cv ( $av->ARRAY ) {
 678             next unless ref($cv) and $cv->FILE eq $0;
 679             $cv->lintcv;
 680         }
 681     }
 682
 683     walksymtable(
 684         \%main::,
 685         sub {
 686             if ( $_[0]->FILE eq $0 ) { $_[0]->lintcv }
 687         },
 688         sub {1}
 689     );
 690     return;
 691 }
 692
 693 sub compile {
 694     my @options = @_;
 695
 696     # Turn on default lint checks
 697     for my $opt (@default_checks) {
 698         $check{$opt} = 1;
 699     }
 700
 701 OPTION:
 702     while ( my $option = shift @options ) {
 703         my ( $opt, $arg );
 704         unless ( ( $opt, $arg ) = $option =~ m/\A-(.)(.*)/xms ) {
 705             unshift @options, $option;
 706             last OPTION;
 707         }
 708
 709         if ( $opt eq "-" && $arg eq "-" ) {
 710             shift @options;
 711             last OPTION;
 712         }
 713         elsif ( $opt eq "D" ) {
 714             $arg ||= shift @options;
 715             foreach my $arg ( split //, $arg ) {
 716                 if ( $arg eq "o" ) {
 717                     B->debug(1);
 718                 }
 719                 elsif ( $arg eq "O" ) {
 720                     $debug_op = 1;
 721                 }
 722             }
 723         }
 724         elsif ( $opt eq "u" ) {
 725             $arg ||= shift @options;
 726             push @extra_packages, $arg;
 727         }
 728     }
 729
 730     foreach my $opt ( @default_checks, @options ) {
 731         $opt =~ tr/-/_/;
 732         if ( $opt eq "all" ) {
 733             %check = %valid_check;
 734         }
 735         elsif ( $opt eq "none" ) {
 736             %check = ();
 737         }
 738         else {
 739             if ( $opt =~ s/\Ano_//xms ) {
 740                 $check{$opt} = 0;
 741             }
 742             else {
 743                 $check{$opt} = 1;
 744             }
 745             carp "No such check: $opt"
 746                 unless defined $valid_check{$opt};
 747         }
 748     }
 749
 750     # Remaining arguments are things to check. So why aren't I
 751     # capturing them or something? I don't know.
 752
 753     return \&do_lint;
 754 }
 755
 756 sub register_plugin {
 757     my ( undef, $plugin, $new_checks ) = @_;
 758
 759     # Allow the user to be lazy and not give us a name.
 760     $plugin = caller unless defined $plugin;
 761
 762     # Register the plugin's named checks, if any.
 763     for my $check ( eval {@$new_checks} ) {
 764         if ( not defined $check ) {
 765             carp 'Undefined value in checks.';
 766             next;
 767         }
 768         if ( exists $valid_check{$check} ) {
 769             carp
 770                 "$check is already registered as a $valid_check{$check} feature.";
 771             next;
 772         }
 773
 774         $valid_check{$check} = $plugin;
 775     }
 776
 777     # Register a non-Module::Pluggable loaded module. @plugins already
 778     # contains whatever M::P found on disk. The user might load a
 779     # plugin manually from some arbitrary namespace and ask for it to
 780     # be registered.
 781     if ( not any { $_ eq $plugin } @plugins ) {
 782         push @plugins, $plugin;
 783     }
 784
 785     return;
 786 }
 787
 788 1;