view release on metacpan or  search on metacpan

t/repos/package.pl  view on Meta::CPAN

use warnings;
use strict;

our $PROG='t/package.pl';

sub sumfiles
{
	my($pd) = @_;
	my $sum;
	find(sub { $sum += -s $_ if(-f $_ && !/.PKGINFO/); }, $pd);
	return $sum;
}

sub readpi
{
	my($ipath) = @_;
	unless(-f $ipath && -r $ipath){
		print STDERR "$PROG: $ipath is missing.\n";
		exit 1;
	}

	my %pinfo;
	open my $if, '<', $ipath or die "open: $!";
	while(<$if>){
		my ($name, $val) = split / = /;
		my @vals = split /\s+/, $val;
		$pinfo{$name} = \@vals;
	}
	close $if or die "close: $!";
	return \%pinfo;
}

sub writepi
{
	my($pinfo, $ipath) = @_;

	open my $of, '>', $ipath or die "open: $!";
	while(my($k, $v) = each %$pinfo){
		print $of "$k = @$v\n";
	}
	close $of or die "close: $!";
	return;
}

sub updatepi
{
	my($pi, $pd) = @_;
	$pi->{'builddate'} = [ time ];
	$pi->{'size'} = [ sumfiles($pd) ];
	$pi->{'packager'} = [ 'ALPM Module' ];
	return;
}

sub remkdir
{
	my($d) = @_;
	if(-d $d){
		system 'rm' => ('-r', $d);
		if($?){
			printf STDERR "$PROG: rm -r $d failed: error code %d\n", $? >> 8;
			exit 1;
		}
	}
	unless(mkdir $d){
		print STDERR "$PROG: mkdir $d failed: $!\n";
		exit 1;
	}
	return;
}

sub mktmpdir
{
	my($base) = @_;
	remkdir("$base/tmp");
	return "$base/tmp";
}

sub pkgfname
{
	my($pi) = @_;
	return sprintf '%s-%s-%s.pkg.tar.xz',
		map { $_->[0] } @{$pi}{qw/pkgname pkgver arch/};
}

sub buildpkg
{
	my($pi, $pd, $td) = @_;

	my $parentd = dirname($td);
	remkdir($td);
	system 'cp' => ('-R', $pd, $parentd);
	if($?){
		print STDERR "$PROG: failed to cp $pd to $parentd\n";
		exit 1;
	}

	unlink("$td/.PKGINFO") or die "unlink: $!";
	updatepi($pi, $td);
	writepi($pi, "$td/.PKGINFO");

	my $fname = pkgfname($pi);
	my $oldwd = getcwd();
	chdir $td or die "chdir: $!";
	system qq{bsdtar -cf - .PKGINFO * | xz -z > ../$fname};
	if($?){
		printf STDERR "$PROG: xz returned %d\n", $? >> 8;
		exit 1;
	}
	chdir $oldwd or die "chdir: $!";

	return "$parentd/$fname";
}

sub dirsin
{
	my($p) = @_;
	opendir my $dh, $p or die "opendir $p: $!";
	my @dirs = grep { !/^[.]/ && -d "$p/$_" } readdir $dh;
	closedir $dh;
	return @dirs;