view release on metacpan or  search on metacpan

lib/RPM/Payload.pm  view on Meta::CPAN

package RPM::Payload;

use 5.008;
use strict;

our $VERSION = '0.11';

sub new {
	my ($class, $f) = @_;
	open my $fh, "-|", "rpm2cpio", $f
		or die "$f: rpm2cpio failed";
	# n1: current data pos
	# n2: end data pos
	# n3: next entry pos
	bless [ $f, $fh, 0, 0, 0 ] => $class;
}

sub _skip ($$$) {
	my ($f, $fh, $n) = @_;
	while ($n > 0) {
		my $m = ($n > 8192) ? 8192 : $n;
		$m == read $fh, my $buf, $m
			or die "$f: cannot skip cpio bytes";
		$n -= $m;
	}
}

sub next {
	my $self = shift;
	my ($f, $fh, $n1, $n2, $n3) = @$self;
	if ($n3 > $n1) {
		_skip($f, $fh, $n3 - $n1);
		$n1 = $n3;
	}
	110 == read $fh, my $cpio_header, 110
		or die "$f: cannot read cpio header";
	$n1 += 110;

	my ($magic, $ino, $mode, $uid, $gid, $nlink, $mtime, $size,
	$dev_major, $dev_minor, $rdev_major, $rdev_minor, $namelen, $checksum) =
		map hex, unpack "a6(a8)13", $cpio_header;
	$magic == 0x070701 or die "$f: bad cpio header magic";

	my $namesize = (($namelen + 1) & ~3) + 2;
	$namesize == read $fh, my $filename, $namesize
		or die "$f: cannot read cpio filename";
	$n1 += $namesize;
	substr $filename, $namelen, $namesize, "";
	chop($filename) eq "\0"
		or die "$f: bad cpio filename";

	$n2 = $n1 + $size;
	$n3 = ($n2 + 3) & ~3;
	#warn "filename=$filename\tdatapos=$n1 end=$n2 next=$n3\n";
	@$self[2,3,4] = ($n1, $n2, $n3);

	return if $filename eq "TRAILER!!!";

	my $entry = {
		filename => $filename,
		ino	=> $ino,
		mode	=> $mode,
		uid	=> $uid,
		gid	=> $gid,
		nlink	=> $nlink,
		mtime	=> $mtime,
		size	=> $size,
		dev_major => $dev_major, dev_minor => $dev_minor,
		rdev_major => $rdev_major, rdev_minor => $rdev_minor,
		dev	=> ($dev_major << 8) | $dev_minor,
		rdev	=> ($rdev_major << 8) | $rdev_minor,
		_cpio	=> $self,
	};
	bless $entry, "RPM::Payload::entry";
}