view release on metacpan or  search on metacpan

lib/App/ModuleBuildTiny/Dist.pm  view on Meta::CPAN

				web  => "https://github.com/$1/$2/issues",
			};
		}
	}
	return %result;
}

sub write_dir {
	my ($self, $dir, $verbose) = @_;
	mkpath($dir, $verbose, oct '755');
	my $files = $self->{files};
	for my $filename (keys %{$files}) {
		my $target = "$dir/$filename";
		mkpath(dirname($target)) if not -d dirname($target);
		if ($files->{$filename}) {
			write_text($target, $files->{$filename});
		}
		else {
			copy($filename, $target);
		}
	}
}

sub write_tarball {
	my ($self, $name) = @_;
	require Archive::Tar;
	my $arch = Archive::Tar->new;
	for my $filename ($self->files) {
		$arch->add_data($filename, $self->get_file($filename), { mode => oct '0644'} );
	}
	$arch->write($name, &Archive::Tar::COMPRESS_GZIP, $name =~ s/.tar.gz$//r);
	return $name;
}

sub files {
	my $self = shift;
	return keys %{ $self->{files} };
}

sub get_file {
	my ($self, $filename) = @_;
	return if not exists $self->{files}{$filename};
	my $raw = $self->{files}{$filename};
	return $raw ? encode_utf8($raw) : read_binary($filename);
}

sub run {
	my ($self, %opts) = @_;
	require File::Temp;
	my $dir  = File::Temp::tempdir(CLEANUP => 1);
	$self->write_dir($dir, $opts{verbose});
	local $CWD = $dir;
	my $ret = !!1;
	if ($opts{build}) {
		system $Config{perlpath}, 'Build.PL' and ($opts{allow_failure} or die "Could not run Build.PL");
		system $Config{perlpath}, 'Build' and ($opts{allow_failure} or die "Could not run Build");
		my @extralib = map { rel2abs("blib/$_") } 'arch', 'lib';
		local @PERL5LIB = (@extralib, @PERL5LIB);
		local @PATH = (rel2abs(catdir('blib', 'script')), @PATH);
		for my $command (@{ $opts{commands} }) {
			say join ' ', @{$command} if $opts{verbose};
			$ret &&= not system @{$command};
		}
	}
	else {
		for my $command (@{ $opts{commands} }) {
			say join ' ', @{$command} if $opts{verbose};
			$ret &&= not system @{$command};
		}
	}
	return $ret;
}

for my $method (qw/meta license/) {
	no strict 'refs';
	*$method = sub { my $self = shift; return $self->{$method}; };
}

for my $method (qw/name version release_status/) {
	no strict 'refs';
	*$method = sub { my $self = shift; return $self->{meta}->$method; }
}

sub fullname {
	my $self = shift;
	my $trial = $self->release_status eq 'testing' && $self->version !~ /_/;
	return $self->meta->name . '-' . $self->meta->version . ($trial ? '-TRIAL' : '' );
}

sub archivename {
	my $self = shift;
	return $self->fullname . '.tar.gz';
}

1;