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

use Archive::Cpio::Common;

my $TRAILER    = 'TRAILER!!!';
my $BLOCK_SIZE = 512;

my @HEADER = (
    magic =&gt; 6,
    inode =&gt; 8,
    mode =&gt; 8,
    uid =&gt; 8,
    gid =&gt; 8,
    nlink =&gt; 8,
    mtime =&gt; 8,
    datasize =&gt; 8,
    devMajor =&gt; 8,
    devMinor =&gt; 8,
    rdevMajor =&gt; 8,
    rdevMinor =&gt; 8,
    namesize =&gt; 8,
    checksum =&gt; 8,
);

sub new {
    my ($class, $magic) = @_;
    bless { magic =&gt; hex($magic) }, $class;
}

sub read_one {
    my ($o, $FHwp) = @_;
    my $entry = read_one_header($o, $FHwp);

    $entry-&gt;{name} = $FHwp-&gt;read($entry-&gt;{namesize});
    $entry-&gt;{name} =~ s/\0$//;

    $entry-&gt;{name} ne $TRAILER or return;
    $FHwp-&gt;read(padding(4, $entry-&gt;{namesize} + 2));

    $entry-&gt;{data} = $FHwp-&gt;read($entry-&gt;{datasize});
    $FHwp-&gt;read(padding(4, $entry-&gt;{datasize}));

    cleanup_entry($entry);

    $entry;
}

sub read_one_header {
    my ($o, $FHwp) = @_;

    my %h;
    my @header = @HEADER;
    while (@header) {
        my $field = shift @header;
        my $size =  shift @header;
        $h{$field} = $FHwp-&gt;read($size);
        $h{$field} =~ /^[0-9A-F]*$/si or die "bad header value $h{$field}\n";
        $h{$field} = hex $h{$field};
    }
    $h{magic} == $o-&gt;{magic} or die "bad magic ($h{magic} vs $o-&gt;{MAGIC})\n";

    \%h;
}

sub write_one {
    my ($o, $F, $entry) = @_;

    $entry-&gt;{magic} = $o-&gt;{magic};
    $entry-&gt;{namesize} = length($entry-&gt;{name}) + 1;
    $entry-&gt;{datasize} = length($entry-&gt;{data});

    write_or_die($F, pack_header($entry) .
                     $entry-&gt;{name} . "\0" .
                     "\0" x padding(4, $entry-&gt;{namesize} + 2));
    write_or_die($F, $entry-&gt;{data});
    write_or_die($F, "\0" x padding(4, $entry-&gt;{datasize}));

    cleanup_entry($entry);
}

sub write_trailer {
    my ($o, $F) = @_;

    write_one($o, $F, { name =&gt; $TRAILER, data =&gt; '', nlink =&gt; 1 });
    write_or_die($F, "\0" x padding($BLOCK_SIZE, tell($F)));
}

sub cleanup_entry {
    my ($entry) = @_;

    foreach ('datasize', 'namesize', 'magic') {
        delete $entry-&gt;{$_};
    }
}

sub pack_header {
    my ($h) = @_;

    my $packed = '';
    my @header = @HEADER;
    while (@header) {
        my $field = shift @header;
        my $size =  shift @header;

        $packed .= sprintf("%0${size}X", $h-&gt;{$field} || 0);
    }
    $packed;
}

1;
</pre></body></html>