Acme-Perl-VM
7 results

 view release on metacpan or  search on metacpan

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

# Perl versions (eg, 5.8.1).
sub _version ($) {
	my $s = shift || 0;
	my $d =()= $s =~ /(\.)/g;
	if ( $d >= 2 ) {
		# Normalise multipart versions
		$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
	}
	$s =~ s/^(\d+)\.?//;
	my $l = $1 || 0;
	my @v = map {
		$_ . '0' x (3 - length $_)
	} $s =~ /(\d{1,3})\D?/g;
	$l = $l . '.' . join '', @v if @v;
	return $l + 0;
}

sub _cmp ($$) {
	_version($_[0]) <=> _version($_[1]);
}

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

  my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';

  # XXX: pick a default, later -- rjbs, 2008-02-24
  my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
     @dirs = grep { -d } @dirs;

  if ($recurse) {
    require File::Find;
    my %test_dir;
    File::Find::find(_wanted(\%test_dir), @dirs);
    $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
  } else {
    $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
  }
}

#line 107

1;

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

	if ( $self->tests ) {
		die "tests_recursive will not work if tests are already defined";
	}
	my $dir = shift || 't';
	unless ( -d $dir ) {
		die "tests_recursive dir '$dir' does not exist";
	}
	%test_dir = ();
	require File::Find;
	File::Find::find( \&_wanted_t, $dir );
	$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}

sub write {
	my $self = shift;
	die "&Makefile->write() takes no arguments\n" if @_;

	# Check the current Perl version
	my $perl_version = $self->perl_version;
	if ( $perl_version ) {
		eval "use $perl_version; 1"

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

	if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
		$args->{SIGN} = 1;
	}
	unless ( $self->is_admin ) {
		delete $args->{SIGN};
	}

	# Merge both kinds of requires into prereq_pm
	my $prereq = ($args->{PREREQ_PM} ||= {});
	%$prereq = ( %$prereq,
		map { @$_ }
		map { @$_ }
		grep $_,
		($self->configure_requires, $self->build_requires, $self->requires)
	);

	# Remove any reference to perl, PREREQ_PM doesn't support it
	delete $args->{PREREQ_PM}->{perl};

	# merge both kinds of requires into prereq_pm
	my $subdirs = ($args->{DIR} ||= []);
	if ($self->bundles) {

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

	}

	if ( my $perl_version = $self->perl_version ) {
		eval "use $perl_version; 1"
			or die "ERROR: perl: Version $] is installed, "
			. "but we need version >= $perl_version";
	}

	$args->{INSTALLDIRS} = $self->installdirs;

	my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;

	my $user_preop = delete $args{dist}->{PREOP};
	if (my $preop = $self->admin->preop($user_preop)) {
		foreach my $key ( keys %$preop ) {
			$args{dist}->{$key} = $preop->{$key};
		}
	}

	my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
	$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');

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

		push @{$self->{values}->{$key}}, @_;
		return $self;
	};
}

foreach my $key ( @resource_keys ) {
	*$key = sub {
		my $self = shift;
		unless ( @_ ) {
			return () unless $self->{values}->{resources};
			return map  { $_->[1] }
			       grep { $_->[0] eq $key }
			       @{ $self->{values}->{resources} };
		}
		return $self->{values}->{resources}->{$key} unless @_;
		my $uri = shift or die(
			"Did not provide a value to $key()"
		);
		$self->resources( $key => $uri );
		return 1;
	};

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

	*$key = sub {
		my $self = shift;
		return $self->{values}->{$key} unless @_;
		my @added;
		while ( @_ ) {
			my $module  = shift or last;
			my $version = shift || 0;
			push @added, [ $module, $version ];
		}
		push @{ $self->{values}->{$key} }, @added;
		return map {@$_} @added;
	};
}

# Resource handling
my %lc_resource = map { $_ => 1 } qw{
	homepage
	license
	bugtracker
	repository
};

sub resources {
	my $self = shift;
	while ( @_ ) {
		my $name  = shift or last;

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

		# The user used ->feature like ->features by passing in the second
		# argument as a reference.  Accomodate for that.
		$mods = $_[0];
	} else {
		$mods = \@_;
	}

	my $count = 0;
	push @$features, (
		$name => [
			map {
				ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
			} @$mods
		]
	);

	return @$features;
}

sub features {
	my $self = shift;

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


	# Load the advisory META.yml file
	my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
	my $meta = $yaml[0];

	# Overwrite the non-configure dependency hashs
	delete $meta->{requires};
	delete $meta->{build_requires};
	delete $meta->{recommends};
	if ( exists $val->{requires} ) {
		$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
	}
	if ( exists $val->{build_requires} ) {
		$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
	}

	return $meta;
}

1;

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

    my $msg = mess(@_);
    my $cxix = $#PL_cxstack;
    while( ($cxix = dopoptosub($cxix)) >= 0 ){
        my $cx   = $PL_cxstack[$cxix];
        my $cop  = $cx->oldcop;

        my $args;

        if($cx->argarray){
            $args = sprintf '(%s)', join q{,},
            map{ defined($_) ? qq{'$_'} : 'undef' }
                @{ $cx->argarray->object_2svref };
        }
        else{
            $args = '';
        }

        my $cvgv = $cx->cv->GV;
        $msg .= sprintf qq{[APVM]   %s%s called at %s line %d.\n},
            gv_fullname($cvgv), $args,
            $cop->file, $cop->line;

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

}
sub TOPMARK(){
    return $PL_markstack[-1];
}

sub PUSH{
    push @PL_stack, @_;
    return;
}
sub mPUSH{
    PUSH(map{ sv_2mortal($_) } @_);
    return;
}
sub POP(){
    return pop @PL_stack;
}
sub TOP(){
    return $PL_stack[-1];
}
sub SET{
    my($sv) = @_;

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


my %not_a_scalar;
@not_a_scalar{qw(AV HV CV IO)} = ();
sub is_scalar{
    my($sv) = @_;
    return !exists $not_a_scalar{ $sv->class };
}

sub mark_list{
    my($mark) = @_;
    return map{ ${ $_->object_2svref } } splice @PL_stack, $mark+1;
}


our %external;

sub apvm_extern{
    foreach my $arg(@_){
        if(ref $arg){
            if(ref($arg) ne 'CODE'){
                Carp::croak('Not a CODE reference for apvm_extern()');

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

    $ddx->Terse(TRUE);
    $ddx->Quotekeys(FALSE);
    $ddx->Useqq(TRUE);
    return $ddx if defined wantarray;

    my $name = ( split '::', (caller 2)[3] )[-1];
    print STDERR $name, ': ', $ddx->Dump(), "\n";
    return;
}
sub dump_object{
    ddx([[ map{ $_ ? $_->object_2svref : $_ } @_ ]]);
}

sub dump_value{
    ddx([\@_]);
}


sub dump_stack{
    require Data::Dumper;
    no warnings 'once';

    local $Data::Dumper::Indent    = 0;
    local $Data::Dumper::Terse     = TRUE;
    local $Data::Dumper::Quotekeys = FALSE;
    local $Data::Dumper::Useqq     = TRUE;

    deb "(%s)\n", join q{,}, map{
        # find variable name
        my $varname = '';
        my $class   = $_->class;

        if($class eq 'SPECIAL'){
            ($varname = $_->special_name) =~ s/^\&PL_//;
            $varname;
        }
        elsif($class eq 'CV'){
            $varname = '&' . gv_fullname($_->GV);

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

            }
            $varname . Data::Dumper->Dump([is_scalar($_) ? ${$_->object_2svref} : $_->object_2svref], [$_->ROK ? 'SV' : '*SV']);
        }

    } @PL_stack;

    return;
}
sub _dump_stack{
    my $warn;
    my $ddx = ddx([[map{
            if(ref $_){
                is_scalar($_) ? ${$_->object_2svref} : $_->object_2svref;
            }
            else{
                $warn++;
                $_;
            }
    } @PL_stack]], ['*PL_stack']);
    $ddx->Indent(0);
    deb "  %s\n", $ddx->Dump();

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

    else{
        my @args;
        av_assign(svref_2object(\@args), splice @PL_stack, $mark+1);

        if($gimme == G_SCALAR){
            my $ret = $cv->object_2svref->(@args);
            mPUSH(svref_2object(\$ret));
        }
        elsif($gimme == G_ARRAY){
            my @ret = $cv->object_2svref->(@args);
            mPUSH(map{ svref_2object(\$_) } @ret);
        }
        else{
            $cv->object_2svref->(@args);
        }
        return $PL_op->next;
    }
}

sub pp_leavesub{
    my $cx    = POPBLOCK;

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

        &pp_rv2gv;
        $PL_last_in_gv = POP;
    }

    # do_readline
    my $targ    = GET_TARGETSTACKED;
    my $istream = $PL_last_in_gv->object_2svref;

    my $gimme = GIMME_V;
    if($gimme == G_ARRAY){
        mPUSH(map{ svref_2object(\$_) } readline $istream);
    }
    else{
        $targ->setval(scalar readline $istream);
        PUSH($targ);
    }

    return $PL_op->next;
}

sub pp_print{

xt/01_podspell.t  view on Meta::CPAN 

#!perl -w

use strict;
use Test::More;

eval q{ use Test::Spelling };

plan skip_all => q{Test::Spelling is not installed.}
	if $@;

add_stopwords(map { split /[\s\:\-]/ } <DATA>);
$ENV{LANG} = 'C';
all_pod_files_spelling_ok('lib');

__DATA__
Goro Fuji (gfx)
gfuji(at)cpan.org
Acme::Perl::VM
APVM
gfx
ppcode



( run in 1.150 second using v1.01-cache-2.11-cpan-49f99fa48dc )