File Coverage

blib/lib/Linux/Perl/getdents.pm

Criterion	Covered	Total	%
statement	41	45	91.1
branch	4	8	50.0
condition			n/a
subroutine	9	9	100.0
pod	1	1	100.0
total	55	63	87.3

package Linux::Perl::getdents;

=encoding utf-8

=head1 NAME

Linux:Perl::getdents - read full directory information

=head1 SYNOPSIS

    #Platform-specific invocation uses e.g.:
    #   Linux::Perl::getdents::arm->getdents(...)

    my @entities = Linux::Perl::getdents->getdents( $filehandle, $buffer_size );

=head1 DESCRIPTION

This module provides support for the kernel-level logic to read directories.

Directories store more than just the node names that Perl’s C
returns; for example, they store the file type and node number. By calling
the kernel’s C logic directly, you can get this
information without making additional system calls.

=cut

use strict;
use warnings;

use parent qw( Linux::Perl::Base::BitsTest );

use Linux::Perl;
use Linux::Perl::Endian;
use Linux::Perl::EasyPack;

use constant {
    DT_UNKNOWN => 0,
    DT_FIFO => 1,
    DT_CHR => 2,
    DT_DIR => 4,
    DT_BLK => 6,
    DT_REG => 8,
    DT_LNK => 10,
    DT_SOCK => 12,
    DT_WHT => 14,
};

my ($lde64_keys, $lde64_pack, $lde64_start_size);
BEGIN {
    ($lde64_keys, $lde64_pack) = Linux::Perl::EasyPack::split_pack_list(
        ino => __PACKAGE__->_PACK_u64(), #ino64_t
        off => __PACKAGE__->_PACK_u64(), #off64_t
        reclen => 'S!',
        type => 'C',
        #name => 'a*',
    );

    $lde64_start_size = length pack $lde64_pack;
}

=head1 METHODS

In addition to the following, this module exposes the constants
C et al. (cf. C)

=head2 @ENTRIES = I->getdents( $FILEHANDLE_OR_FD, $READ_SIZE )

Reads from the given $FILEHANDLE_OR_FD using a buffer of $READ_SIZE bytes.
There’s no good way to know how many @ENTRIES you can receive given the
$READ_SIZE, unfortunately.

The return is a list of hash references; each hash contains the keys
C, C, C, and C. These correspond with the relevant
parts of struct C (cf. C).

(In scalar context, this returns the number of hash references that would
be returned in list context.)

For now, this is implemented via the C system call.

B Perl 5.20 and earlier doesn’t understand C on a directory
handle, so to use this function you’ll need to pass the file descriptor rather
than the handle. (To get the file descriptor, you can parse F
for the symlink that refers to the directory’s path. See this module’s tests
for an implementation of this.)

=cut

sub getdents {
    my ($class, $fh_or_fileno, $bufsize) = @_;

    if (!$class->can('NR_getdents64')) {
        require Linux::Perl::ArchLoader;
        $class = Linux::Perl::ArchLoader::get_arch_module($class);
    }

    my $buf = "\0" x $bufsize;

    my $fileno;

    if ( ref $fh_or_fileno ) {
        $fileno = fileno($fh_or_fileno);

        if (!defined $fileno) {
            die "Filehandle ($fh_or_fileno) has no underlying file descriptor!";
        }
    }
    else {
        $fileno = $fh_or_fileno;

        if (!defined $fileno) {
            die "Neither a filehandle nor a file descriptor was given!";
        }
    }

    my $bytes = Linux::Perl::call(
        0 + $class->NR_getdents64(),
        0 + $fileno,
        $buf,
        0 + $bufsize,
    );

    my @structs;
    while ($bytes > 0) {
        my %struct;
        @struct{ @$lde64_keys } = unpack $lde64_pack, substr( $buf, 0, $lde64_start_size, q<> );

        ( $struct{'name'} = substr( $buf, 0, $struct{'reclen'} - $lde64_start_size, q<> ) ) =~ tr<\0><>d;

        push @structs, \%struct;

        $bytes -= delete $struct{'reclen'};
    }

    return @structs;
}

1;