view release on metacpan or  search on metacpan

lib/Acme/Locals.pm  view on Meta::CPAN

sub printx      ($@); ## no critic
sub sprintfx    ($@); ## no critic

sub import {
    my ($this_class, @tags) = @_;
    my $call_class = caller 0;

    my @to_export;
    for my $tag (@tags) {
        if ($tag =~ m/^:/xms) {
            croak __PACKAGE__, " does not support the tag  $tag"
                if not exists $EXPORT_TAGS{$tag};

            push @to_export, @{ $EXPORT_TAGS{$tag} };
        }
        elsif ($tag =~ m/^-/xms) {
            $mode_for_class{$call_class} = $tag;
        }
        else {
            push @to_export, $tag;
        }
    }
    $mode_for_class{$call_class} ||= $DEFAULT_MODE;
    if (not exists $MODES{ $mode_for_class{$call_class} }) {
        my $cur_mode = $mode_for_class{$call_class};
        carp "Unknown mode $cur_mode. Switching to default mode $DEFAULT_MODE";
        $mode_for_class{$call_class} = $DEFAULT_MODE;
    }

    no strict 'refs'; ## no critic
    for my $export_sub (@to_export) {
        croak __PACKAGE__, " does not export $export_sub"
            if not exists $EXPORT_OK{$export_sub};
    
        *{ $call_class . "::$export_sub" } = $EXPORT_OK{$export_sub};
    }

    return;
}

sub sayx ($@){ ## no critic
    say sprintx([caller 0], @_);
}

sub printx ($@) { ## no critic
    print sprintx([caller 0], @_);
}

sub sprintx ($@) { ## no critic
    my $peek_level = 1;
    my $call_class;
    if (_ARRAY( $_[0] )) {
        $call_class = shift->[0];
        $peek_level++;
    }
    $call_class ||= caller 0;

    my ($fmt, %bind_vars) = @_;

    my @binds;
    my $map_bind_var = sub {
        my ($bind_var_name, $format_char) = @_;
        local *__ANON__ = 'map_bind_var'; ## no critic

        my $internal_name = $bind_var_name;
        if (exists $bind_vars{$internal_name}) {
            # pass
        }
        elsif (exists $bind_vars{q{$}.$internal_name}) {
            $internal_name = q{$}.$internal_name;
        }
        else {
            croak "No such bind var: $bind_var_name";
        }

        my $value_ref = $bind_vars{$internal_name};
        croak 'Bind var must be scalar'
            if not _SCALAR($value_ref);

        push @binds, ${ $value_ref };

        return defined $format_char ? q{%} . $format_char
                                    : $DEFAULT_FORMAT;
    };

    my $mode = $mode_for_class{$call_class} || $DEFAULT_MODE;
    my $re   = $MODES{ $mode };

    if ($mode eq '-ruby' && !scalar keys %bind_vars) {
        %bind_vars = %{ PadWalker::peek_my($peek_level) };
    }
    
    $fmt =~ s/$re/$map_bind_var->($1, $2)/xmseg;

    return sprintf $fmt, @binds;
}

sub lexicals {
    goto &locals;
}

sub locals {
    return wantarray ? %{ PadWalker::peek_my(1) }
                     :    PadWalker::peek_my(1);
}

sub globals {
    return wantarray ? %{ PadWalker::peek_our(1) }
                     :    PadWalker::peek_our(1);
}

1;

__END__

=begin wikidoc

= NAME

Acme::Locals - Interpolate like Python/Ruby.

= VERSION

This document describes Acme::Locals version v0.0.1

= SYNOPSIS

    # Python mode

    use Acme::Locals qw(-python :all);

    sub foo {
        my $x   = 10;
        my $y   = 100;
        my $who = "world";
        sayx '%(x)d %(y)d hello %(who)s!', locals();
    }


    # Ruby mode

    use Acme::Locals qw(-ruby :all);

    sub bar {
        my $x   = 10;
        my $y   = 100;
        my $who = "world";

        sayx '#{x} #{y} hello #{who}';
    }


= DESCRIPTION