view release on metacpan or  search on metacpan

lib/Code/ART.pm  view on Meta::CPAN

package Code::ART;

use 5.016;
use warnings;
use Carp;
use Scalar::Util 'looks_like_number';
use List::Util   qw< min max uniq>;
use version;

our $VERSION = '0.000005';

# Default naming scheme for refactoring...
my $DEFAULT_SUB_NAME          = '__REFACTORED_SUB__';
my $DEFAULT_LEXICAL_NAME      = '__HOISTED_LEXICAL__';
my $DEFAULT_DATA_PARAM        = '@__EXTRA_DATA__';
my $DEFAULT_AUTO_RETURN_VALUE = '@__RETURN_VALUE__';

# These are the permitted options for refactor_to_sub()...
my %VALID_REFACTOR_OPTION = ( name=>1, from=>1, to=>1, data=>1, return=>1 );

# These are the permitted options for hoist_to_lexical()...
my %VALID_HOIST_OPTION    = ( name=>1, from=>1, to=>1, closure=>1, all=>1 );

# Load the module...
sub import {
    my $package = shift;
    my $opt_ref = shift // {};

    croak("Options argument to 'use $package' must be a hash reference")
        if ref($opt_ref) ne 'HASH';

#    # Remember lexically scoped options...
#    for my $optname (keys %{$opt_ref}) {
#        croak "Unknown option ('$optname') passed to 'use $package'"
#            if !$VALID_REFACTOR_OPTION{$optname} && !$VALID_HOIST_OPTION{$optname};
#        $^H{"Code::ART $optname"} = $opt_ref->{$optname};
#    }

    # Export the API...
    no strict 'refs';
    *{caller().'::refactor_to_sub'}         = \&refactor_to_sub;
    *{caller().'::rename_variable'}         = \&rename_variable;
    *{caller().'::classify_all_vars_in'}    = \&classify_all_vars_in;
    *{caller().'::hoist_to_lexical'}        = \&hoist_to_lexical;
}


# This regex recognizes variables that don't need to be passed in
# even if they're not locally declared...
my $PERL_SPECIAL_VAR = qr{
    \A
    [\$\@%]
    (?:
        [][\d\{!"#\$%&'()*+,./:;<=>?\@\^`|~_-]
    |
        \^ .*
    |
        \{\^ .*
    |
        ACCUMULATOR | ARG | ARGV | ARRAY_BASE | AUTOLOAD | BASETIME | CHILD_ERROR |
        COMPILING | DEBUGGING | EFFECTIVE_GROUP_ID | EFFECTIVE_USER_ID | EGID | ENV |
        ERRNO | EUID | EVAL_ERROR | EXCEPTIONS_BEING_CAUGHT | EXECUTABLE_NAME |
        EXTENDED_OS_ERROR | F | FORMAT_FORMFEED | FORMAT_LINES_LEFT | FORMAT_LINES_PER_PAGE |
        FORMAT_LINE_BREAK_CHARACTERS | FORMAT_NAME | FORMAT_PAGE_NUMBER | FORMAT_TOP_NAME |
        GID | INC | INPLACE_EDIT | INPUT_LINE_NUMBER | INPUT_RECORD_SEPARATOR |
        LAST_MATCH_END | LAST_MATCH_START | LAST_PAREN_MATCH | LAST_REGEXP_CODE_RESULT |
        LAST_SUBMATCH_RESULT | LIST_SEPARATOR | MATCH | NR | OFMT | OFS | OLD_PERL_VERSION |
        ORS | OSNAME | OS_ERROR | OUTPUT_AUTOFLUSH | OUTPUT_FIELD_SEPARATOR |
        OUTPUT_RECORD_SEPARATOR | PERLDB | PERL_VERSION | PID | POSTMATCH | PREMATCH |
        PROCESS_ID | PROGRAM_NAME | REAL_GROUP_ID | REAL_USER_ID | RS | SIG | SUBSCRIPT_SEPARATOR |
        SUBSEP | SYSTEM_FD_MAX | UID | WARNING | a | b
    )
    \Z
}x;

# What a simple variable looks like...
my $SIMPLE_VAR = qr{ \A [\$\@%] [^\W\d] \w* \Z }xms;

# What whitespace look like...
my $OWS = qr{ (?: \s++ | \# [^\n]*+ (?> \n | \Z ))*+ }xms;

# This is where the magic happens: parse the code and extract the undeclared variables...
use PPR::X;
use re 'eval';

# Refactor the code into a subroutine...
sub refactor_to_sub {
    # Unpack args...
    my ($opt_ref) = grep { ref($_) eq 'HASH' } @_, {};
    my ($code, @extras) = grep { !ref($_) } @_;

    # Check raw arguments...
    croak( "'code' argument of refactor_to_sub() must be a string" ) if !defined($code) || ref($code);
    croak( "Unexpected extra argument passed to refactor_to_sub(): '$_'" ) for @extras;
    croak( "'options' argument of refactor_to_sub() must be hash ref, not ", lc(ref($_)), " ref" )
        for grep { ref($_) && ref($_) ne 'HASH' } @_;