view release on metacpan or  search on metacpan

lib/Function/Runner.pm  view on Meta::CPAN

package Function::Runner;

use strict; use warnings; use utf8; use 5.10.0;
use Data::Dumper;
our $VERSION = '0.003';


my $PEEK_LEVEL = 5;     # Disallow peeks below this level
sub peek {      # ( $level, $res ) --> $res
    my ($level, $res) = @_;

    # Comment out logging in PROD
    _log_save($res);

    # Guard: Do nothing if $level is lower than PEEK_LEVEL
    return $res if $level < $PEEK_LEVEL;

    # Print content of $res
    my $file = (caller(0))[1];
    my $line = (caller(0))[2];

    say "$file line $line: ". Dumper $res;
    return $res;
}

my $LOG   = [];         # Container for logs from peek()
sub _log_save {   # ($res)
    my $res = shift;
    # Add to log regardless of PEEK_LEVEL
    my $pkg  = (caller(1))[0];
    my $file = (caller(1))[1];
    my $line = (caller(1))[2];
    push @$LOG, ["file:$file - pkg:$pkg - line:$line: ",$res];
    #push @$LOG, "file:$file - pkg:$pkg - line:$line: ".$res;
    return $res;
}
sub _log_fetch { return $LOG }
sub _log_clear { $LOG = [] }


## CONSTRUCTORS
sub new {
    # Clear the LOG
    $LOG = [];

    my $fn_map  = {};                   # initial function map
    my $defn    = $_[1];                # user-provided function definition
    my $pkg = (caller)[0];              # calling package
    _die("missing defn or pkg") unless defined $defn && defined $pkg;

    # See: https://perldoc.perl.org/perlmod#Symbol-Tables
    my $tab = eval '\%'.$pkg.'::';      # symbol table of calling package
    peek 3, ['Symbol Table: ','\%'.$pkg.'::',"has ref: \"".ref($tab).'"'];

    _mk_fn_map($fn_map,$defn,$tab,$pkg);# build fn_map from $defn and $tab
    peek 3, ['Completed fn_map: ',$fn_map];

    bless { defn=>$defn,
            fn=>$fn_map,
            log=>{ step => [],      # Store steps and results
                   func => [] }     # Store funcs and results
          },
          $_[0];
}


## METHODS
my $LEVEL = 0;          # Tracks recursion levels
sub _mk_fn_map {
    my ($fn_map, $defn, $tab, $pkg) = @_;

    # Walk the defn, get all coderefs
    foreach my $step (keys %$defn) {
        my $res = $defn->{$step};
        my $ref = ref $res;
        peek 3, ["Processing StepDef: $step",$res, " has res: \"$ref\""];

        if ($ref eq '') {                       # Coderef. e.g. '&bye' or '/greet'
            # Guard: Skip if Step not Func
            #   Step Example: '/greet'
            #   Func Example: '&bye'
            if ($res =~ /^\/(.*)/) {
                peek 3, "Ignored StepDef when building fn_map: $res";
                next;
            }

            my ($sym) = ($res =~ /^&(.*)/);
            peek 3, "Processing Func: $res";
            _die("Bad res: $res") unless defined $sym;

            # Guard: Skip if already in $fn_map
            if (exists $fn_map->{$sym}) {
                peek 3, "Func already mapped: $res";
                next;
            }

            # Guard: The given symbol e.g. 'hello' must be defined as a
            #        function in the calling package
            my $is_code = eval 'defined &'.$pkg.'::'.$sym ? 1 : 0;
            peek 3, "Func: $res is code: \"$is_code\"";
            _die("\n\n"."\"$sym\" not a coderef in \"$pkg\"")
                unless $is_code;

            # Add mapping of symbol to coderef
            $fn_map->{$sym} = $tab->{$sym};
            peek 3, "Add to fn_map: $res";

        } elsif ($ref eq 'HASH') {              # Defn e.g. { ':ok' => ... }