view release on metacpan or  search on metacpan

t/preptests.pl  view on Meta::CPAN

#!/usr/bin/env perl
use warnings;
use strict;

use Cwd;
use English qw(-no_match_vars);
use File::Find;
use File::Copy;
use File::Path qw(make_path remove_tree);
use File::Spec::Functions qw(rel2abs catfile);
use File::Basename qw(dirname);

my $PROG = 'preptests';
my $REPODIR = 'repos';

## Variables inside the test.conf need absolute paths, assigned later.
my ($REPOSHARE, $TESTROOT);
my $TESTCONF = 'test.conf';

sub createconf
{
	my($path, $root, $repos) = @_;
	open my $of, '>', $path
		or die "failed to open t/test.conf file: $!";
	print $of <<"END_CONF";
[options]
RootDir = $root
DBPath = $root/db
CacheDir = $root/cache
LogFile = $root/test.log
#GPGDir      = $root/gnupg/
HoldPkg     = pacman glibc
SyncFirst   = pacman
#XferCommand = /usr/bin/curl -C - -f %u > %o
#XferCommand = /usr/bin/wget --passive-ftp -c -O %o %u
CleanMethod = KeepInstalled
Architecture = auto

# Pacman won't upgrade packages listed in IgnorePkg and members of IgnoreGroup
#IgnorePkg   =
#IgnoreGroup =

#NoUpgrade   =
#NoExtract   =

# Misc options
#UseSyslog
#UseDelta
#TotalDownload
CheckSpace
#VerbosePkgLists

# PGP signature checking
SigLevel = Optional

END_CONF

	while(my($repo, $path) = each %$repos){
		print $of <<"END_CONF"
[$repo]
SigLevel = Optional TrustAll
Server = file://$path

END_CONF
	}

	close $of;
}

sub buildpkgs
{
	chdir 'repos' or die "chdir: $!";
	my @lines = `perl package.pl`;
	chdir '..' or die "chdir: $!";

	if(@?){
		printf STDERR "$PROG: package.pl script failed: code %d\n", $? >> 8;
		exit 1;
	}

	my %repos;
	for (@lines){
		chomp;
		my($r, @rest) = split /\t/;
		push @{$repos{$r}}, join "\t", @rest;
	}

	return \%repos;
}

sub remkdir
{
	my($dir) = @_;
	die "WTF?" if($dir eq '/');
	remove_tree($dir);
	mkdir($dir);
	return;
}

sub mkroot
{
	remkdir($TESTROOT);
	my @dirs = glob("$TESTROOT/{gnupg,cache,{db/{local,cache}}}");
	make_path(@dirs, { mode => 0755 });
}

sub corruptpkg