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


line stmt bran cond sub pod time code
1             package Linux::Perl::getdents;
2              
3             =encoding utf-8
4              
5             =head1 NAME
6              
7             Linux:Perl::getdents - read full directory information
8              
9             =head1 SYNOPSIS
10              
11             #Platform-specific invocation uses e.g.:
12             # Linux::Perl::getdents::arm->getdents(...)
13              
14             my @entities = Linux::Perl::getdents->getdents( $filehandle, $buffer_size );
15              
16             =head1 DESCRIPTION
17              
18             This module provides support for the kernel-level logic to read directories.
19              
20             Directories store more than just the node names that Perl’s C
21             returns; for example, they store the file type and node number. By calling
22             the kernel’s C logic directly, you can get this
23             information without making additional system calls.
24              
25             =cut
26              
27 3     3   169842 use strict;
  3         6  
  3         78  
28 3     3   15 use warnings;
  3         6  
  3         69  
29              
30 3     3   12 use parent qw( Linux::Perl::Base::BitsTest );
  3         6  
  3         15  
31              
32 3     3   1248 use Linux::Perl;
  3         6  
  3         69  
33 3     3   978 use Linux::Perl::Endian;
  3         18  
  3         75  
34 3     3   1119 use Linux::Perl::EasyPack;
  3         6  
  3         102  
35              
36             use constant {
37 3         402 DT_UNKNOWN => 0,
38             DT_FIFO => 1,
39             DT_CHR => 2,
40             DT_DIR => 4,
41             DT_BLK => 6,
42             DT_REG => 8,
43             DT_LNK => 10,
44             DT_SOCK => 12,
45             DT_WHT => 14,
46 3     3   12 };
  3         6  
47              
48             my ($lde64_keys, $lde64_pack, $lde64_start_size);
49             BEGIN {
50 3     3   24 ($lde64_keys, $lde64_pack) = Linux::Perl::EasyPack::split_pack_list(
51             ino => __PACKAGE__->_PACK_u64(), #ino64_t
52             off => __PACKAGE__->_PACK_u64(), #off64_t
53             reclen => 'S!',
54             type => 'C',
55             #name => 'a*',
56             );
57              
58 3         756 $lde64_start_size = length pack $lde64_pack;
59             }
60              
61             =head1 METHODS
62              
63             In addition to the following, this module exposes the constants
64             C et al. (cf. C)
65              
66             =head2 @ENTRIES = I->getdents( $FILEHANDLE_OR_FD, $READ_SIZE )
67              
68             Reads from the given $FILEHANDLE_OR_FD using a buffer of $READ_SIZE bytes.
69             There’s no good way to know how many @ENTRIES you can receive given the
70             $READ_SIZE, unfortunately.
71              
72             The return is a list of hash references; each hash contains the keys
73             C, C, C, and C. These correspond with the relevant
74             parts of struct C (cf. C).
75              
76             (In scalar context, this returns the number of hash references that would
77             be returned in list context.)
78              
79             For now, this is implemented via the C system call.
80              
81             B Perl 5.20 and earlier doesn’t understand C on a directory
82             handle, so to use this function you’ll need to pass the file descriptor rather
83             than the handle. (To get the file descriptor, you can parse F
84             for the symlink that refers to the directory’s path. See this module’s tests
85             for an implementation of this.)
86              
87             =cut
88              
89             sub getdents {
90 2     2 1 348433 my ($class, $fh_or_fileno, $bufsize) = @_;
91              
92 2 100       87 if (!$class->can('NR_getdents64')) {
93 1         1889 require Linux::Perl::ArchLoader;
94 1         13 $class = Linux::Perl::ArchLoader::get_arch_module($class);
95             }
96              
97 2         78 my $buf = "\0" x $bufsize;
98              
99 2         4 my $fileno;
100              
101 2 50       22 if ( ref $fh_or_fileno ) {
102 2         13 $fileno = fileno($fh_or_fileno);
103              
104 2 50       15 if (!defined $fileno) {
105 0         0 die "Filehandle ($fh_or_fileno) has no underlying file descriptor!";
106             }
107             }
108             else {
109 0         0 $fileno = $fh_or_fileno;
110              
111 0 0       0 if (!defined $fileno) {
112 0         0 die "Neither a filehandle nor a file descriptor was given!";
113             }
114             }
115              
116 2         44 my $bytes = Linux::Perl::call(
117             0 + $class->NR_getdents64(),
118             0 + $fileno,
119             $buf,
120             0 + $bufsize,
121             );
122              
123 2         6 my @structs;
124 2         11 while ($bytes > 0) {
125 10         14 my %struct;
126 10         59 @struct{ @$lde64_keys } = unpack $lde64_pack, substr( $buf, 0, $lde64_start_size, q<> );
127              
128 10         45 ( $struct{'name'} = substr( $buf, 0, $struct{'reclen'} - $lde64_start_size, q<> ) ) =~ tr<\0><>d;
129              
130 10         19 push @structs, \%struct;
131              
132 10         28 $bytes -= delete $struct{'reclen'};
133             }
134              
135 2         14 return @structs;
136             }
137              
138             1;