<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Archive::Cpio;

use strict;
use warnings;

our $VERSION = '0.10';

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

=head1 NAME

Archive::Cpio - module for manipulations of cpio archives

=head1 SYNOPSIS

    use Archive::Cpio;

    # simple example removing entry "foo"

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

     # more complex example, filtering on the fly

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

=head1 DESCRIPTION

Archive::Cpio provides a few functions to read and write cpio files.

=cut


=head2 Archive::Cpio-&gt;new()

Create an object

=cut

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

=head2 $cpio-&gt;read($filename)

=head2 $cpio-&gt;read($filehandle)

Reads the cpio file

=cut

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

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

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

=head2 $cpio-&gt;write($filename)

=head2 $cpio-&gt;write($filehandle)

Writes the entries and the trailer

=cut

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

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

    # Set the format if not done or if specified
    if (!$cpio-&gt;{archive_format} || $fmt) {
        $cpio-&gt;{archive_format} = _create_archive_format($fmt || 'ODC');
    }

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

=head2 $cpio-&gt;remove(@filenames)

Removes any entries with names matching any of the given filenames from the in-memory archive

=cut

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

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

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

=head2 $cpio-&gt;get_files([ @filenames ])

Returns a list of C&lt;Archive::Cpio::File&gt; (after a C&lt;$cpio-&gt;read&gt;)

=cut

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

=head2 $cpio-&gt;get_file($filename)

Returns the C&lt;Archive::Cpio::File&gt; matching C&lt;$filename&lt; (after a C&lt;$cpio-&gt;read&gt;)

=cut

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

=head2 $cpio-&gt;add_data($filename, $data, $opthashref)

Takes a filename, a scalar full of data and optionally a reference to a hash with specific options.

Will add a file to the in-memory archive, with name C&lt;$filename&gt; and content C&lt;$data&gt;.
Specific properties can be set using C&lt;$opthashref&gt;.

=cut

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

=head2 $cpio-&gt;read_with_handler($filehandle, $coderef)

Calls the handler function on each header. An C&lt;Archive::Cpio::File&gt; is passed as a parameter

=cut

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

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

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

=head2 $cpio-&gt;write_one($filehandle, $entry)

Writes a C&lt;Archive::Cpio::File&gt; (beware, a valid cpio needs a trailer using C&lt;write_trailer&gt;)

=cut

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

=head2 $cpio-&gt;write_trailer($filehandle)

Writes the trailer to finish the cpio file

=cut

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




sub _default_magic {
    my ($archive_format) = @_;
    my $magics = Archive::Cpio::Common::magics();
    my %format2magic = reverse %$magics;
    $format2magic{$archive_format} or die "unknown archive_format $archive_format\n";
}

sub _create_archive_format {
    my ($archive_format, $magic) = @_;

    $magic ||= _default_magic($archive_format);

    # perl_checker: require Archive::Cpio::NewAscii
    # perl_checker: require Archive::Cpio::OldBinary
    my $class = "Archive::Cpio::$archive_format";
    eval "require $class";
    return $class-&gt;new($magic);
}

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

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

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

    foreach my $magic (keys %$magics) {
        my $archive_format = $magics-&gt;{$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
        return _create_archive_format($archive_format, $magic);
    }
    die "invalid archive\n";
}

=head1 AUTHOR

Pascal Rigaux &lt;pixel@mandriva.com&gt;

=cut
</pre></body></html>