Archive::Cpio - module for manipulations of cpio archives

    use Archive::Cpio;

    # simple example removing entry "foo"

    my $cpio = Archive::Cpio->new;
    $cpio->read($file);
    $cpio->remove('foo');
    $cio->write($file);

     # more complex example, filtering on the fly

    my $cpio = Archive::Cpio->new;
    $cpio->read_with_handler(\*STDIN,
                sub {
                    my ($e) = @_;                   
                    if ($e->name ne 'foo') {
                        $cpio->write_one(\*STDOUT, $e);
                    }
                });
    $cpio->write_trailer(\*STDOUT);

package Archive::Cpio;

our $VERSION = 0.09;

use Archive::Cpio::Common;
use Archive::Cpio::File;
use Archive::Cpio::OldBinary;

sub new {
    my ($class, %options) = @_;
    bless \%options, $class;
}

sub read {
    my ($cpio, $file) = @_;
    
    my $IN;
    if (ref $file) {
	$IN = $file;
    } else {
	open($IN, '<', $file) or die "can't open $file: $!\n";
    }

    read_with_handler($cpio, $IN, sub { 
        my ($e) = @_;
	push @{$cpio->{list}}, $e;
    });
}

sub write {
    my ($cpio, $file) = @_;

    my $OUT;
    if (ref $file) {
	$OUT = $file;
    } else {
	open($OUT, '>', $file) or die "can't open $file: $!\n";
    }

    $cpio->write_one($OUT, $_) foreach @{$cpio->{list}};
    $cpio->write_trailer($OUT);
}

sub remove {
    my ($cpio, @filenames) = @_;
    $cpio->{list} or die "can't remove from nothing\n";

    my %filenames = map { $_ => 1 } @filenames;

    @{$cpio->{list}} = grep { !$filenames{$_->name} } @{$cpio->{list}};
}

sub get_files {
    my ($cpio, @list) = @_;
    if (@list) {
	map { get_file($cpio, $_) } @list;
    } else {
	@{$cpio->{list}};
    }
}

sub get_file {
    my ($cpio, $file) = @_;
    foreach (@{$cpio->{list}}) {
	$_->name eq $file and return $_;
    }
    undef;
}

sub add_data {
    my ($cpio, $filename, $data, $opthashref) = @_;
    my $entry = $opthashref || {};
    $entry->{name} = $filename;
    $entry->{data} = $data;
    $entry->{nlink} = 1;
    $entry->{mode} = 0100644;
    push @{$cpio->{list}}, Archive::Cpio::File->new($entry);
}

sub read_with_handler {
    my ($cpio, $F, $handler) = @_;

    my $FHwp = Archive::Cpio::FileHandle_with_pushback->new($F);
    $cpio->{archive_format} ||= detect_archive_format($FHwp);

    while (my $entry = $cpio->{archive_format}->read_one($FHwp)) {
	$entry = Archive::Cpio::File->new($entry);
	$handler->($entry);
    }    
}

sub write_one {
    my ($cpio, $F, $entry) = @_;
    $cpio->{archive_format}->write_one($F, $entry);
}

sub write_trailer {
    my ($cpio, $F) = @_;
    $cpio->{archive_format}->write_trailer($F);
}


sub detect_archive_format {
    my ($FHwp) = @_;

    my $magics = Archive::Cpio::Common::magics();

    my $max_length = max(map { length $_ } values %$magics);
    my $s = $FHwp->read_ahead($max_length);

    foreach my $magic (keys %$magics) {
	my $archive_format = $magics->{$magic};
	begins_with($s, $magic) or next;
	
	#warn "found magic for $archive_format\n";

	# perl_checker: require Archive::Cpio::NewAscii
	# perl_checker: require Archive::Cpio::OldBinary
	my $class = "Archive::Cpio::$archive_format";
	eval "require $class";
	return $class->new($magic, $s);
    }
    die "invalid archive\n";
}