Acme-Perl-VM

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

t/09_hash.t
t/10_rv2xv.t
t/11_readline.t
t/12_anon.t
t/13_foreach.t
t/14_assign2.t
t/15_range.t
t/16_wantarray.t
t/17_pushpop.t
t/18_extern.t
t/19_bless.t
t/20_join.t
t/21_assign3.t
xt/01_podspell.t
xt/02_pod.t
xt/03_pod-coverage.t
xt/04_synopsis.t

inc/Module/Install.pm  view on Meta::CPAN

	$class =~ s/^\Q$args{prefix}\E:://;
	$args{name}     ||= $class;
	$args{version}  ||= $class->VERSION;
	unless ( $args{path} ) {
		$args{path}  = $args{name};
		$args{path}  =~ s!::!/!g;
	}
	$args{file}     ||= "$args{base}/$args{prefix}/$args{path}.pm";
	$args{wrote}      = 0;

	bless( \%args, $class );
}

sub call {
	my ($self, $method) = @_;
	my $obj = $self->load($method) or return;
        splice(@_, 0, 2, $obj);
	goto &{$obj->can($method)};
}

sub load {

inc/Module/Install/Base.pm  view on Meta::CPAN

#line 42

sub new {
	my $class = shift;
	unless ( defined &{"${class}::call"} ) {
		*{"${class}::call"} = sub { shift->_top->call(@_) };
	}
	unless ( defined &{"${class}::load"} ) {
		*{"${class}::load"} = sub { shift->_top->load(@_) };
	}
	bless { @_ }, $class;
}

#line 61

sub AUTOLOAD {
	local $@;
	my $func = eval { shift->_top->autoload } or return;
	goto &$func;
}

inc/Module/Install/Base.pm  view on Meta::CPAN

	$_[0]->admin->VERSION;
}

sub DESTROY {}

package Module::Install::Base::FakeAdmin;

my $fake;

sub new {
	$fake ||= bless(\@_, $_[0]);
}

sub AUTOLOAD {}

sub DESTROY {}

# Restore warning handler
BEGIN {
	$SIG{__WARN__} = $SIG{__WARN__}->();
}

inc/Module/Install/Metadata.pm  view on Meta::CPAN

sub version_from {
	require ExtUtils::MM_Unix;
	my ( $self, $file ) = @_;
	$self->version( ExtUtils::MM_Unix->parse_version($file) );
}

sub abstract_from {
	require ExtUtils::MM_Unix;
	my ( $self, $file ) = @_;
	$self->abstract(
		bless(
			{ DISTNAME => $self->name },
			'ExtUtils::MM_Unix'
		)->parse_abstract($file)
	 );
}

# Add both distribution and module name
sub name_from {
	my ($self, $file) = @_;
	if (

lib/Acme/Perl/VM.pm  view on Meta::CPAN

no Mouse;
__PACKAGE__->meta->make_immutable();

package
    Acme::Perl::VM::Alias;


sub TIESCALAR{
    my($class, $scalar_ref) = @_;
    return bless [$scalar_ref], $class;
}
sub FETCH{
    return ${ $_[0]->[0] }
}
sub STORE{
    ${ $_[0]->[0] } = $_[1];
    return;
}

lib/Acme/Perl/VM/B.pm  view on Meta::CPAN

    constant->import(G_WANT => G_SCALAR() | G_ARRAY() | G_VOID());
    push @EXPORT, qw(G_WANT);
}
unless(defined &OPpITER_REVERSED){
    constant->import(OPpITER_REVERSED => 0x00);
    push @EXPORT, qw(OPpITER_REVERSED);
}

push @EXPORT, qw(NULL TRUE FALSE USE_ITHREADS sv_yes sv_no);
use constant {
    NULL         => bless(\do{ my $addr = 0 }, 'B::SPECIAL'),
    TRUE         => 1,
    FALSE        => 0,
    USE_ITHREADS => defined(&B::regex_padav),

    sv_yes       => B::sv_yes,
    sv_no        => B::sv_no,
};


package

lib/Acme/Perl/VM/B.pm  view on Meta::CPAN

package
    B::SV;

# for sv_setsv()
sub setsv{
    my($dst, $src) = @_;

    my $dst_ref = $dst->object_2svref;
    ${$dst_ref} = ${$src->object_2svref};
    bless $dst, ref(B::svref_2object( $dst_ref ));

    return $dst;
}

# for sv_setpv()/sv_setiv()/sv_setnv() etc.
sub setval{
    my($dst, $val) = @_;

    my $dst_ref = $dst->object_2svref;
    ${$dst_ref} = $val;
    bless $dst, ref(B::svref_2object( $dst_ref ));

    return $dst;
}

sub clear{
    my($sv) = @_;

    ${$sv->object_2svref} = undef;
    return;
}

lib/Acme/Perl/VM/PP.pm  view on Meta::CPAN

    my $gv   = ($PL_op->flags & OPf_STACKED) ? $PL_stack[++$mark]->object_2svref : defoutgv;

    local $\ = "\n";
    my $ret  = print {$gv} mark_list($mark);

    $#PL_stack = $origmark;
    PUSH( $ret ? sv_yes : sv_no );
    return $PL_op->next;
}

sub pp_bless{
    my $pkg;
    if(MAXARG == 1){
        $pkg = $PL_curcop->stashpv;
    }
    else{
        my $sv = POP;
        if($sv->ROK){
            apvm_die 'Attempt to bless into a reference';
        }
        $pkg = SvPV($sv);
        if($pkg eq ''){
            apvm_warn q{Explicit blessing to '' (assuming package main)};
        }
    }
    bless ${TOP->object_2svref}, $pkg;
    return $PL_op->next;
}

sub pp_push{
    my $mark = POPMARK;
    my $av   = $PL_stack[++$mark];
    my $n    = push @{$av->object_2svref}, mark_list($mark);
    SETval($n);
    return $PL_op->next;
}

lib/Acme/Perl/VM/Run.pm  view on Meta::CPAN

use B qw(main_start comppadlist);

no warnings 'void';
INIT{
    return if APVM_DUMMY;

    if(is_not_null(main_start)){
        ENTER;
        SAVETMPS;

        $PL_curcop ||= bless \do{ my $addr = 0 }, 'B::COP'; # dummy cop

        $PL_op = main_start;
        PAD_SET_CUR(comppadlist, 1);

        $PL_runops->();

        FREETMPS;
        LEAVE;
    }
    exit;

lib/Acme/Perl/VM/Scope.pm  view on Meta::CPAN

sub _save{
    my($self) = @_;
    return Acme::Perl::VM::gv_fullname($self->gv, '$');
}

sub save_type(){ 'SCALAR' }
sub create_ref{
    my($self) = @_;

    if($self->gv->SV->MAGICAL){
        bless $self, 'Acme::Perl::VM::Scope::Scalar::Magical';
        $self->old_value(${$self->old_ref});
        return \local(${*{ $self->gv->object_2svref }}); # to copy MAGIC
    }
    else{
        return \my $scalar;
    }
}
sub sv{
    my($self) = @_;
    return $self->gv->SV;

t/19_bless.t  view on Meta::CPAN

use Acme::Perl::VM;
use Acme::Perl::VM qw(:perl_h);

apvm_extern 'Test::More';

{
    package Foo;

    sub new{
        my $class = shift;
        return bless {@_}, $class;
    }
    sub bar{ 'Foo::bar' }

    sub attr{
        $_[0]->{attr};
    }
    sub set_attr{
        $_[0]->{attr} = $_[1];
    }