view release on metacpan or  search on metacpan

lib/Util/EvalSnippet.pm  view on Meta::CPAN

package Util::EvalSnippet;
use 5.020;
use strict;
use warnings;
use PadWalker qw(peek_my peek_our);
use File::Slurp qw(read_file);
use Cwd 'abs_path';

our $VERSION = '0.02';

sub import {
  my ($package, $msg) = @_;
  if ($msg and $msg eq 'safe' and !$ENV{ALLOW_SNIPPETS}) {
    die "\n\nCan't use Util::EvalSnippet in 'safe' mode if ALLOW_SNIPPETS env var is not set";
  }
  my $callerpkg = caller(0);
  no strict 'refs';
  *{"$callerpkg\::eval_snippet"} = \&eval_snippet;
}

our $snippet_intro=q{# --snippet-info-header--
# This is a snippet. It will run in the context of the place where it was called from
# For documentation, "perldoc Util::EvalSnippet"
# This snippet was created here:
# line: %s
# file: %s
# (note, line number may have changed since this snippet was created!)
# --snippet-info-header--
};

sub eval_snippet {

  my $snippet_name = shift || '';
  $snippet_name =~ /^\w*$/ or die "Snippet name must be word characters only";

  my ($caller_package,$caller_filename,$caller_line) = (caller(0));

  my $snippet_dir = _snippet_dir();

  my $snippet_path = $snippet_dir.'/'.$caller_package;
  $snippet_name and $snippet_path.="-$snippet_name";

  unless (-f $snippet_path) {
    unless (-d $snippet_dir) {
      mkdir($snippet_dir) or die "Can't make snippet dir ($snippet_dir): $!";
    }
    open(my $fh,">",$snippet_path)
      or die "Can't create snippet ($snippet_path)";
    my $path = abs_path($caller_filename);
    printf $fh $snippet_intro,$caller_line,$path;
    close($fh);
  }

  # interpolate variables
  my $peek_my  = peek_my(1);
  my $peek_our = peek_our(1);

  my $content = read_file($snippet_path);

  $content = _process(
               content => $content,
               type    => 'my',
               vars    => [keys %$peek_my],
             );