File Coverage

blib/lib/Sys/Export/VFAT/Directory.pm

Criterion	Covered	Total	%
statement	113	115	98.2
branch	23	32	71.8
condition	4	8	50.0
subroutine	23	23	100.0
pod	14	14	100.0
total	177	192	92.1

package Sys::Export::VFAT::Directory;

our $VERSION = '0.005'; # VERSION
# ABSTRACT: Represents a case-folded directory in VFAT


use v5.26;
use warnings;
use experimental qw( signatures );
use Sys::Export::LogAny '$log';
use Encode ();
use Sys::Export::VFAT;
use Scalar::Util qw( weaken );
use List::Util qw( min max );
use Carp;
our @CARP_NOT= qw( Sys::Export::VFAT );


sub new($class, %attrs) {
   my $self= bless {
      name        => delete $attrs{name},
      parent      => delete $attrs{parent},
      file        => delete $attrs{file},
      entries     => delete $attrs{entries} // [],
      ent_by_name => {},
   }, $class;
   croak "Unknown constructor option ".join(', ', keys %attrs) if keys %attrs;
   weaken($self->{parent}) if $self->{parent};
   for ($self->entries->@*) {
      $self->ent_by_name->{$_->{name}}= $_->{name};
      $self->ent_by_name->{$_->{shortname}}= $_->{shortname} if defined $_->{shortname};
   }
   $self;
}


sub name        { $_[0]{name} }
sub parent      { $_[0]{parent} }
sub is_root     { !defined $_[0]{parent} }
sub file        { $_[0]{file} }
sub entries     { $_[0]{entries} }
sub ent_by_name { $_[0]{ent_by_name} }


sub entry {
   $_[0]{ent_by_name}{lc $_[1]}
}


sub add($self, $name, $file, %attrs) {
   croak "Invalid long name" unless $self->is_valid_name($name);
   $attrs{name}= $name;
   $attrs{file}= $file;
   $attrs{shortname} //= $name if $self->is_valid_shortname($name);
   # any conflict?
   my $by_name= $self->ent_by_name;
   croak "Path ".$self->name."/$name already exists"
      if defined $by_name->{lc $name};
   if (defined $attrs{shortname}) {
      utf8::downgrade($attrs{shortname}); # must be bytes
      my $slot= \$by_name->{lc $attrs{shortname}};
      croak "Path ".$self->name."/$name short name '$attrs{shortname}' conflicts with "
         . $self->name."/".$$slot->{name}
         if $$slot;
      $$slot= \%attrs;
   }
   $by_name->{lc $name}= \%attrs;
   push $self->entries->@*, \%attrs;
   \%attrs;
}


# These 3 can be overridden for ISO9660 subclass
sub is_valid_name($self, $name) {
   Sys::Export::VFAT::is_valid_longname($name)
}
sub is_valid_shortname($self, $name) {
   Sys::Export::VFAT::is_valid_shortname($name)
}
sub remove_invalid_shortname_chars($self, $name, $repl) {
   Sys::Export::VFAT::remove_invalid_shortname_chars($name, $repl)
}


sub find_unused_shortname($self, $name) {
   length $name or croak "name cannot be empty";
   my $by_name= $self->ent_by_name;
   my $ext_pos= rindex($name, '.');
   my $base= $ext_pos < 0? $name : substr($name, 0, $ext_pos);
   my $ext=  $ext_pos < 0? ''    : substr($name, $ext_pos+1);
   for ($base, $ext) {
      $_= $self->remove_invalid_shortname_chars($_, '_');
      # Now that all high characters have been removed, optimize these as bytes
      utf8::downgrade($_);
   }
   $ext= '.'.substr($ext,0,3) if length $ext;
   my ($iter, $iter_len, $base_len)= (0,0, length $base);
   if (!$base_len || $base_len > 8) {
      substr($base, min($base_len,6), $base_len, '~1');
      ($iter, $iter_len)= (1, 2);
   }
   while ($by_name->{lc $base.$ext}) {
      my $next_iter_len= 1 + length ++$iter;
      my $iter_pos= min($base_len, 8 - $next_iter_len);
      croak "Can't find available ~N suffix for '$name'"
         if $iter_pos < 0;
      substr($base, $iter_pos, $next_iter_len, '~'.$iter);
      $iter_len= $next_iter_len;
   }
   $self->is_valid_shortname($base.$ext) or die "BUG: '$base$ext' is not a valid shortname";
   return $base.$ext;
}


sub build_shortnames($self) {
   my $by_name= $self->ent_by_name;
   for (sort { lc $a->{name} cmp lc $b->{name} } $self->entries->@*) {
      unless (defined $_->{shortname}) {
         $_->{shortname}= $self->find_unused_shortname($_->{name});
         $by_name->{lc $_->{shortname}}= $_;
      }
   }
   return $self;
}

# Avoiding dependency on namespace::clean
delete @{Sys::Export::VFAT::Directory::}{qw( carp confess croak min max weaken )};
1;

__END__