use Strict::Subs; foo(); # The subroutine main::foo might be called but it doesn't exist yet. #### package Strict::Subs; use strict; use warnings; use Exporter; use B::Utils qw( all_roots anon_subs ); use vars qw( %Violations @ISA @EXPORT $VERSION ); BEGIN { $VERSION = '0.01'; @ISA = 'Exporter'; @EXPORT = 'strict_subs'; 1; } sub import { eval q[ CHECK { # Provide a named way to trigger this apply_strict_subs(); 1; } ]; } sub strict_subs () { 'strict_subs()'; } sub apply_strict_subs { local %Violations; # All named subroutines. { my %named_subs = all_roots(); _strict_sub( $_ ) for values %named_subs; } # All anonymous subroutines _strict_sub( $_->{'root'} ) for anon_subs(); 1; } sub _strict_sub { my $root = shift; walkoptree_filtered( $root, \ &_find_strict_sub_invocation, \ &_apply_strict_subs ); 1; } sub _find_strict_sub_invocation { my $op = shift; opgrep( { name => 'gv' }, $op ) and do { my $gv = $op->sv; ( $gv->NAME eq 'strict_subs' and $gv->STASH->NAME eq 'Strict' ) } } sub _apply_strict_subs { my $op = shift; walkoptree_filtered( $_, \ &_find_subroutine_calls, \ &_validate_subroutine_existance ) for $op->younger_siblings(); 1; } sub _find_subrountine_calls { opgrep( { name => 'gv' next => { name => 'entersub ' } } ); } sub _validate_subroutine_existance { my $op_gv = shift; my $gv = $op_gv->sv; my $name = $gv->STASH->NAME . '::' . $gv->NAME; no strict 'refs'; *{$name}{'CODE'} or warn "The subroutine $name might be called but it doesn't exist yet.\n" } package B::Utils; sub younger_siblings { my $op = shift; my @siblings; for ( my $sibling = $op->sibling; $sibling->oldname ne 'null'; $op = $sibling ) { push @siblings, $sibling; } @siblings; }