Acme-AirRead

 view release on metacpan or  search on metacpan

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

	$string =~ s/^\n+//s;
	return $string;
}

# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
	local *FH;
	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
	foreach ( 1 .. $#_ ) {
		print FH $_[$_] or die "print($_[0]): $!";
	}
	close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
	local *FH;
	open( FH, "> $_[0]"  ) or die "open($_[0]): $!";
	foreach ( 1 .. $#_ ) {
		print FH $_[$_] or die "print($_[0]): $!";
	}
	close FH or die "close($_[0]): $!";
}
END_OLD

# _version is for processing module versions (eg, 1.03_05) not
# 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;
}

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

		return 0;
	}

	# Write a C file representative of what XS becomes
	require File::Temp;
	my ( $FH, $tmpfile ) = File::Temp::tempfile(
		"compilexs-XXXXX",
		SUFFIX => '.c',
	);
	binmode $FH;
	print $FH <<'END_C';
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

int main(int argc, char **argv) {
    return 0;
}

int boot_sanexs() {
    return 1;

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

        $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;

    if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
        $args{url} = $args{ftp_url}
            or (warn("LWP support unavailable!\n"), return);
        ($scheme, $host, $path, $file) =
            $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
    }

    $|++;
    print "Fetching '$file' from $host... ";

    unless (eval { require Socket; Socket::inet_aton($host) }) {
        warn "'$host' resolve failed!\n";
        return;
    }

    return unless $scheme eq 'ftp' or $scheme eq 'http';

    require Cwd;
    my $dir = Cwd::getcwd();

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

        }

        my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
        foreach (@dialog) { $fh->print("$_\n") }
        $fh->close;
    } }
    else {
        warn "No working 'ftp' program available!\n";
        chdir $dir; return;
    }

    unless (-f $file) {
        warn "Fetching failed: $@\n";
        chdir $dir; return;
    }

    return if exists $args{size} and -s $file != $args{size};
    system($args{run}) if exists $args{run};
    unlink($file) if $args{remove};

    print(((!exists $args{check_for} or -e $args{check_for})
        ? "done!" : "failed! ($!)"), "\n");
    chdir $dir; return !$?;
}

1;

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

	#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;

	# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
	$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;

	# XXX - This is currently unused; not sure if it breaks other MM-users
	# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;

	seek MAKEFILE, 0, SEEK_SET;
	truncate MAKEFILE, 0;
	print MAKEFILE  "$preamble$makefile$postamble" or die $!;
	close MAKEFILE  or die $!;

	1;
}

sub preamble {
	my ($self, $text) = @_;
	$self->{preamble} = $text . $self->{preamble} if defined $text;
	$self->{preamble};
}

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

		my $version = shift @requires;
		$self->test_requires( $module => $version );
	}
}

# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
	my $v = $_[-1];
	$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
	$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
	$v =~ s/(\.\d\d\d)000$/$1/;
	$v =~ s/_.+$//;
	if ( ref($v) ) {
		# Numify
		$v = $v + 0;
	}
	return $v;
}

sub add_metadata {

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

	# We need YAML::Tiny to write the MYMETA.yml file
	unless ( eval { require YAML::Tiny; 1; } ) {
		return 1;
	}

	# Generate the data
	my $meta = $self->_write_mymeta_data or return 1;

	# Save as the MYMETA.yml file
	print "Writing MYMETA.yml\n";
	YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}

sub write_mymeta_json {
	my $self = shift;

	# We need JSON to write the MYMETA.json file
	unless ( eval { require JSON; 1; } ) {
		return 1;
	}

	# Generate the data
	my $meta = $self->_write_mymeta_data or return 1;

	# Save as the MYMETA.yml file
	print "Writing MYMETA.json\n";
	Module::Install::_write(
		'MYMETA.json',
		JSON->new->pretty(1)->canonical->encode($meta),
	);
}

sub _write_mymeta_data {
	my $self = shift;

	# If there's no existing META.yml there is nothing we can do

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

	$self->load('get_file');

	require Config;
	return unless (
		$^O eq 'MSWin32'                     and
		$Config::Config{make}                and
		$Config::Config{make} =~ /^nmake\b/i and
		! $self->can_run('nmake')
	);

	print "The required 'nmake' executable not found, fetching it...\n";

	require File::Basename;
	my $rv = $self->get_file(
		url       => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
		ftp_url   => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
		local_dir => File::Basename::dirname($^X),
		size      => 51928,
		run       => 'Nmake15.exe /o > nul',
		check_for => 'Nmake.exe',
		remove    => 1,

inc/Test/More.pm  view on Meta::CPAN

    my $tb = Test::More->builder;

    unless( @_ == 2 or @_ == 3 ) {
        my $msg = <<'WARNING';
is_deeply() takes two or three args, you gave %d.
This usually means you passed an array or hash instead 
of a reference to it
WARNING
        chop $msg;    # clip off newline so carp() will put in line/file

        _carp sprintf $msg, scalar @_;

        return $tb->ok(0);
    }

    my( $got, $expected, $name ) = @_;

    $tb->_unoverload_str( \$expected, \$got );

    my $ok;
    if( !ref $got and !ref $expected ) {    # neither is a reference