File Coverage

blib/lib/Devel/DidYouMean.pm

Criterion	Covered	Total	%
statement	57	57	100.0
branch	12	14	85.7
condition			n/a
subroutine	10	10	100.0
pod			n/a
total	79	81	97.5

use 5.008;
use warnings;
package Devel::DidYouMean;
$Devel::DidYouMean::VERSION = '0.04';
use vars qw($AUTOLOAD);
use Text::Levenshtein;
use Perl::Builtins;
use Carp 'croak';
no warnings 'once';
no strict qw/refs subs/;

# ABSTRACT: Intercepts failed function and method calls, suggesting the nearest matching alternative.




our $DYM_MATCHING_SUBS = [];

CHECK {

    # add autoload to main
    *{ main::AUTOLOAD } = Devel::DidYouMean::AUTOLOAD;

    # add to every other module in memory
    for (keys %INC)
    {
        my $module = $_;
        $module =~ s/\//::/g;
        $module = substr($module, 0, -3);
        $module .= '::AUTOLOAD';

        # skip if the package already has an autoload
        next if defined *{ $module };

        *{ $module } = Devel::DidYouMean::AUTOLOAD;
    }
}

sub AUTOLOAD
{
    my @sub_path = split /::/, $AUTOLOAD;
    my $sub = pop @sub_path;

    # ignore these calls
    return if grep /$sub/, qw/AUTOLOAD BEGIN CHECK INIT DESTROY END/;

    my $package = join '::', @sub_path;
    my $package_namespace = $package . '::';

    my %valid_subs = ();

    for (keys %$package_namespace)
    {
        my $absolute_name = $package_namespace . $_;
        if (defined &{$absolute_name})
        {
            $valid_subs{$_} = Text::Levenshtein::fastdistance($sub, $_);
        }
    }

    # if package is main, add in builtin functions
    if ($package eq 'main')
    {
        for (Perl::Builtins::list)
        {
            $valid_subs{$_} = Text::Levenshtein::fastdistance($sub, $_);
        }
    }

    $DYM_MATCHING_SUBS = [];
    my $match_score;

    # return similarly named functions
    for (sort { $valid_subs{$a} <=> $valid_subs{$b} } keys %valid_subs)
    {
        next if $_ eq 'AUTOLOAD';
        $match_score = $valid_subs{$_} unless $match_score;

        if ($match_score < $valid_subs{$_})
        {
            croak "Undefined subroutine '$sub' not found in $package. Did you mean "
                . join(', ', @$DYM_MATCHING_SUBS) . '?';
        }
        push @$DYM_MATCHING_SUBS, $_;
    }
}

1;

__END__