File Coverage

blib/lib/Sys/Export/CPIO.pm

Criterion	Covered	Total	%
statement	56	76	73.6
branch	15	40	37.5
condition	23	46	50.0
subroutine	10	13	76.9
pod	6	6	100.0
total	110	181	60.7

package Sys::Export::CPIO;

# ABSTRACT: Write CPIO archives needed for Linux initrd
our $VERSION = '0.003'; # VERSION

use v5.26;
use warnings;
use experimental qw( signatures );
use Fcntl qw( S_IFDIR S_IFMT );
use Scalar::Util 'blessed';
use Carp;
our @CARP_NOT= qw( Sys::Export Sys::Export::Unix );
require Sys::Export::Unix; # for _dev_major_minor


sub new($class, $f, @attrs) {
   croak "Expected even-length key/value list after filename" if @attrs & 1;
   my $filename;
   my $fh= blessed $f && $f->can('print')? $f
      : do { $filename= $f; open my $x, '>:raw', $f or die "open($f): $!"; $x };
   my $self= bless {
      fh => $fh,
      seen_inode => {},
      ino => 0,
      virtual_inodes => 1,
      filename => $filename,
      autoclose => defined $filename,
   }, $class;

   while (@attrs) {
      my ($attr, $val)= splice(@attrs, 0, 2);
      $self->$attr($val);
   }

   $self;
}


sub autoclose {
   $_[0]{autoclose}= !!$_[1] if @_ > 1; # cast to boolean
   $_[0]{autoclose}
}

sub filename {
   $_[0]{filename}= $_[1] if @_ > 1;
   $_[0]{filename}
}

sub virtual_inodes {
   $_[0]{virtual_inodes}= !!$_[1] if @_ > 1; # cast to boolean
   $_[0]{virtual_inodes}
}


sub add($self, $fileinfo) {
   my ($dev, $dev_major, $dev_minor, $ino, $mode, $nlink, $uid, $gid, $rdev, $rdev_major, $rdev_minor, $mtime, $name)
      = @{$fileinfo}{qw( dev dev_major dev_minor ino mode nlink uid gid rdev rdev_major rdev_minor mtime name )};
   # best-effort to extract major/minor from dev and rdev, unless user specified them
   ($dev_major, $dev_minor)= Sys::Export::Unix::_dev_major_minor($dev)
      if defined $dev and !defined $dev_major || !defined $dev_minor;
   ($rdev_major, $rdev_minor)= Sys::Export::Unix::_dev_major_minor($rdev)
      if defined $rdev and !defined $rdev_major || !defined $rdev_minor;
   defined $mode or croak "require 'mode'";
   defined $name or croak "require 'name'";

   my $size= length($fileinfo->{data}) // 0;
   # Handle hard links
   if ($nlink && $nlink > 1 && ($mode & S_IFMT) != S_IFDIR) {
      my $hardlink_key= "$dev_major:$dev_minor:$ino";
      if ($self->virtual_inodes) {
         # the previous virtual inode is stored in the seen_inode hash
         if ($ino= $self->{seen_inode}{$hardlink_key}) {
            $size= 0;
         } else {
            $ino= $self->{seen_inode}{$hardlink_key}= ++$self->{ino};
         }
         ($dev_major, $dev_minor)= (0,0);
      }
      else {
         $size= 0 if $self->{seen_inode}{$hardlink_key}++;
      }
   }
   elsif ($self->virtual_inodes) {
      ($dev_major, $dev_minor, $ino)= (0,0);
   }
   $ino //= ++$self->{ino};

   my $header= sprintf "070701%08X%08X%08X%08X%08X%08X%08X%08X%08X%08X%08X%08X%08X%s\0%s",
      $ino, $mode, $uid//0, $gid//0, $nlink//1, $mtime//0, $size,
      $dev_major//0, $dev_minor//0, $rdev_major//0, $rdev_minor//0,
      1+length $name, 0, $name,
      "\0"x((4 - ((13*8+6+length($name)+1) & 3)) & 3); # pad to multiple of 4
   die "BUG" if length $header & 3;

   $self->{fh}->print($header) || die "write: $!";
   # This is written in multiple parts like this because $fileinfo->{data} might be a File::Map,
   #  and optimal to pass that directly back to fprint without a perl-side concatenation.
   $self->{fh}->print($fileinfo->{data}) || die "write: $!"
      if $size;
   $self->{fh}->print("\0"x(4-($size & 3))) || die "write: $!"
      if $size & 3; # pad to multiple of 4
   $self;
}


sub finish($self) {
   $self->add({ mode => 0, ino => 0, name => 'TRAILER!!!' });
   $self->{fh}->flush;
   $self->{fh}->close if $self->autoclose;
   $self;
}

# Avoiding dependency on namespace::clean
{  no strict 'refs';
   delete @{"Sys::Export::CPIO::"}{qw(
      S_IFDIR S_IFMT blessed carp croak
   )}
}

1;

__END__