[ViewVC] Contents of: cvs/cvsroot/IO-AIO/bin/treescan

#!/opt/bin/perl

# inspired by treescan by Jamie Lokier <jamie@imbolc.ucc.ie>
# about 40% faster than the original version (on my fs and raid :)

=head1 NAME

treescan - scan directory trees, list dirs/files, stat, sync, grep

=head1 SYNOPSIS

   treescan [OPTION...] [PATH...]

      -q, --quiet    do not print list of files/directories
      -0, --print0   use null character instead of newline to separate names
      -s, --stat     call stat on every entry, to get stat data into cache
      -d, --dirs     only list dirs
      -f, --files    only list files
      -p, --progress regularly print progress to stderr
          --sync     open/fsync/close every entry
      -g, --grep=RE  only list files that match the given perl RegEx
          --quote    shell quote when printing filenames

=head1 DESCRIPTION

The F<treescan> command scans directories and their contents
recursively. By default it lists all files and directories (with trailing
C</>), but it can optionally do various other things.

If no paths are given, F<treescan> will use C<.>, the current directory.

=head2 OPTIONS

=over 4

=item -q, --quiet

By default, F<treescan> prints the full paths of all directories or files
it finds. This option disables printing of filenames completely. This is
useful if you want to run F<treescan> solely for its side effects, such as
pulling C<stat> data into memory.

=item -0, --print0

Instead of using newlines, use null characters after each filename. This
is useful to avoid quoting problems when piping the result into other
programs (for example, GNU F<grep>, F<xargs> and so on all have options to
deal with this).

=item -s, --stat

Normally, F<treescan> will use heuristics to avoid most C<stat> calls,
which is what makes it so fast. This option forces it to C<stat> every file.

This is only useful for the side effect of pulling the C<stat> data into
the cache. If your disk cache is big enough, it will be filled with
file meta data after F<treescan> is done, which can speed up subsequent
commands considerably. Often, you can run F<treescan> in parallel with
other directory-scanning programs to speed them up.

=item -d, --dirs

Only lists directories, not file paths. This is useful if you quickly want
a list of directories and their subdirectories.

=item -f, --files

Only list files, not directories. This is useful if you want to operate on
all files in a hierarchy, and the directories would ony get in the way.

=item -p, --progress

Regularly print some progress information to standard error. This is
useful to get some progress information on long running tasks. Since
the progress is printed to standard error, you can pipe the output of
F<treescan> into other programs as usual.

=item --quote

When printing filenames, shell-quote them.

=item --sync

The C<--sync> option can be used to make sure all the files/dirs in a tree
are sync'ed to disk. For example this could be useful after unpacking an
archive, to make sure the files hit the disk before deleting the archive
file itself.

=item -g, --grep=RE

This applies a perl regular expression (see the L<perlre> manpage) to all paths that would normally be printed
and will only print matching paths.

The regular expression uses an C</s> (single line) modifier by default, so
newlines are matched by C<.>.

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

use common::sense;
use Getopt::Long;
use Time::HiRes ();
use IO::AIO;

our $VERSION = $IO::AIO::VERSION;

Getopt::Long::Configure ("bundling", "no_ignore_case", "require_order", "auto_help", "auto_version");

my ($opt_silent, $opt_print0, $opt_stat, $opt_nodirs, $opt_help,
    $opt_nofiles, $opt_grep, $opt_progress, $opt_sync, $opt_shellquote);

GetOptions
   "quiet|q"    => \$opt_silent,
   "print0|0"   => \$opt_print0,
   "stat|s"     => \$opt_stat,
   "dirs|d"     => \$opt_nofiles,
   "files|f"    => \$opt_nodirs,
   "grep|g=s"   => \$opt_grep,
   "progress|p" => \$opt_progress,
   "quote"      => \$opt_shellquote,
   "sync"       => \$opt_sync,
   "help"       => \$opt_help,
   or die "Usage: try $0 --help";

if ($opt_help) {
   require Pod::Usage;

   Pod::Usage::pod2usage (
      -verbose => 1,
      -exitval => 0,
   );
}

@ARGV = "." unless @ARGV;

my @todo; # list of dirs/files still left to scan

$opt_grep &&= qr{$opt_grep}s;

my ($n_dirs, $n_files, $n_stats) = (0, 0, 0);
my ($n_last, $n_start) = (Time::HiRes::time) x 2;

sub printfn {
   my ($prefix, $files, $suffix) = @_;

   if ($opt_grep) {
      @$files = grep "$prefix$_" =~ $opt_grep, @$files;
   }
   
   if ($opt_print0) {
      print map "$prefix$_$suffix\0", @$files;
   } elsif ($opt_shellquote) {
      for (@$files) {
         my $path = "$prefix$_$suffix";
         unless ($path =~ /\A[A-Za-z0-9_.,+%\/:@=-]+\z/) {
            $path =~ s/'/'\\''/g;
            $path = "'$path'";
         }
         print "$path\n";
      }
   } elsif (!$opt_silent) {
      print map "$prefix$_$suffix\n", @$files;
   }
}

sub scan {
   my ($path) = @_;

   $path .= "/";

   IO::AIO::poll_cb;

   if ($opt_progress and $n_last + 1 < Time::HiRes::time) {
      $n_last = Time::HiRes::time;
      my $d = $n_last - $n_start;
      printf STDERR "\r%d dirs (%g/s) %d files (%g/s) %d stats (%g/s)       ",
             $n_dirs, $n_dirs / $d,
             $n_files, $n_files / $d,
             $n_stats, $n_stats / $d;
   }

   aioreq_pri -1;
   ++$n_dirs;
   aio_scandir $path, 8, sub {
      my ($dirs, $files) = @_
         or return warn "$path: $!\n";

      printfn "", [$path]   unless $opt_nodirs;
      printfn $path, $files unless $opt_nofiles;

      $n_files += @$files;

      if ($opt_stat) {
         aio_wd $path, sub {
            my $wd = shift;

            aio_lstat [$wd, $_] for @$files;
            $n_stats += @$files;
         };
      }

      if ($opt_sync) {
         aio_wd $path, sub {
            my $wd = shift;

            aio_pathsync [$wd, $_] for @$files;
            aio_pathsync $wd;
         };
      }

      push @todo, "$path$_"
         for sort { $b cmp $a } @$dirs;
   };
}

IO::AIO::max_outstanding 100; # two fds per directory, so limit accordingly
IO::AIO::min_parallel 20;

@todo = reverse @ARGV;

while () {
   if (@todo) {
      my $seed = pop @todo;
      $seed =~ s/\/+$//;
      aio_lstat "$seed/.", sub {
         if ($_[0]) {
            print STDERR "$seed: $!\n";
         } elsif (-d _) {
            scan $seed;
         } else {
            printfn "", $seed, "/";
         }
      };
   } else {
      IO::AIO::poll_wait;
   }

   last unless IO::AIO::nreqs;

   IO::AIO::poll_cb;
}

Revision:	1.23
Committed:	Tue Sep 22 21:55:21 2026 UTC (7 days, 8 hours ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.22:	+1 -1 lines
Log Message:	* empty log message *
#	Content
1	#!/opt/bin/perl
2
3	# inspired by treescan by Jamie Lokier <jamie@imbolc.ucc.ie>
4	# about 40% faster than the original version (on my fs and raid :)
5
6	=head1 NAME
7
8	treescan - scan directory trees, list dirs/files, stat, sync, grep
9
10	=head1 SYNOPSIS
11
12	treescan [OPTION...] [PATH...]
13
14	-q, --quiet do not print list of files/directories
15	-0, --print0 use null character instead of newline to separate names
16	-s, --stat call stat on every entry, to get stat data into cache
17	-d, --dirs only list dirs
18	-f, --files only list files
19	-p, --progress regularly print progress to stderr
20	--sync open/fsync/close every entry
21	-g, --grep=RE only list files that match the given perl RegEx
22	--quote shell quote when printing filenames
23
24	=head1 DESCRIPTION
25
26	The F<treescan> command scans directories and their contents
27	recursively. By default it lists all files and directories (with trailing
28	C</>), but it can optionally do various other things.
29
30	If no paths are given, F<treescan> will use C<.>, the current directory.
31
32	=head2 OPTIONS
33
34	=over 4
35
36	=item -q, --quiet
37
38	By default, F<treescan> prints the full paths of all directories or files
39	it finds. This option disables printing of filenames completely. This is
40	useful if you want to run F<treescan> solely for its side effects, such as
41	pulling C<stat> data into memory.
42
43	=item -0, --print0
44
45	Instead of using newlines, use null characters after each filename. This
46	is useful to avoid quoting problems when piping the result into other
47	programs (for example, GNU F<grep>, F<xargs> and so on all have options to
48	deal with this).
49
50	=item -s, --stat
51
52	Normally, F<treescan> will use heuristics to avoid most C<stat> calls,
53	which is what makes it so fast. This option forces it to C<stat> every file.
54
55	This is only useful for the side effect of pulling the C<stat> data into
56	the cache. If your disk cache is big enough, it will be filled with
57	file meta data after F<treescan> is done, which can speed up subsequent
58	commands considerably. Often, you can run F<treescan> in parallel with
59	other directory-scanning programs to speed them up.
60
61	=item -d, --dirs
62
63	Only lists directories, not file paths. This is useful if you quickly want
64	a list of directories and their subdirectories.
65
66	=item -f, --files
67
68	Only list files, not directories. This is useful if you want to operate on
69	all files in a hierarchy, and the directories would ony get in the way.
70
71	=item -p, --progress
72
73	Regularly print some progress information to standard error. This is
74	useful to get some progress information on long running tasks. Since
75	the progress is printed to standard error, you can pipe the output of
76	F<treescan> into other programs as usual.
77
78	=item --quote
79
80	When printing filenames, shell-quote them.
81
82	=item --sync
83
84	The C<--sync> option can be used to make sure all the files/dirs in a tree
85	are sync'ed to disk. For example this could be useful after unpacking an
86	archive, to make sure the files hit the disk before deleting the archive
87	file itself.
88
89	=item -g, --grep=RE
90
91	This applies a perl regular expression (see the L<perlre> manpage) to all paths that would normally be printed
92	and will only print matching paths.
93
94	The regular expression uses an C</s> (single line) modifier by default, so
95	newlines are matched by C<.>.
96
97	=back
98
99	=head1 AUTHOR
100
101	Marc Lehmann <schmorp@schmorp.de>
102	http://home.schmorp.de/
103
104	=cut
105
106	use common::sense;
107	use Getopt::Long;
108	use Time::HiRes ();
109	use IO::AIO;
110
111	our $VERSION = $IO::AIO::VERSION;
112
113	Getopt::Long::Configure ("bundling", "no_ignore_case", "require_order", "auto_help", "auto_version");
114
115	my ($opt_silent, $opt_print0, $opt_stat, $opt_nodirs, $opt_help,
116	$opt_nofiles, $opt_grep, $opt_progress, $opt_sync, $opt_shellquote);
117
118	GetOptions
119	"quiet\|q" => \$opt_silent,
120	"print0\|0" => \$opt_print0,
121	"stat\|s" => \$opt_stat,
122	"dirs\|d" => \$opt_nofiles,
123	"files\|f" => \$opt_nodirs,
124	"grep\|g=s" => \$opt_grep,
125	"progress\|p" => \$opt_progress,
126	"quote" => \$opt_shellquote,
127	"sync" => \$opt_sync,
128	"help" => \$opt_help,
129	or die "Usage: try $0 --help";
130
131	if ($opt_help) {
132	require Pod::Usage;
133
134	Pod::Usage::pod2usage (
135	-verbose => 1,
136	-exitval => 0,
137	);
138	}
139
140	@ARGV = "." unless @ARGV;
141
142	my @todo; # list of dirs/files still left to scan
143
144	$opt_grep &&= qr{$opt_grep}s;
145
146	my ($n_dirs, $n_files, $n_stats) = (0, 0, 0);
147	my ($n_last, $n_start) = (Time::HiRes::time) x 2;
148
149	sub printfn {
150	my ($prefix, $files, $suffix) = @_;
151
152	if ($opt_grep) {
153	@$files = grep "$prefix$_" =~ $opt_grep, @$files;
154	}
155
156	if ($opt_print0) {
157	print map "$prefix$_$suffix\0", @$files;
158	} elsif ($opt_shellquote) {
159	for (@$files) {
160	my $path = "$prefix$_$suffix";
161	unless ($path =~ /\A[A-Za-z0-9_.,+%\/:@=-]+\z/) {
162	$path =~ s/'/'\\''/g;
163	$path = "'$path'";
164	}
165	print "$path\n";
166	}
167	} elsif (!$opt_silent) {
168	print map "$prefix$_$suffix\n", @$files;
169	}
170	}
171
172	sub scan {
173	my ($path) = @_;
174
175	$path .= "/";
176
177	IO::AIO::poll_cb;
178
179	if ($opt_progress and $n_last + 1 < Time::HiRes::time) {
180	$n_last = Time::HiRes::time;
181	my $d = $n_last - $n_start;
182	printf STDERR "\r%d dirs (%g/s) %d files (%g/s) %d stats (%g/s) ",
183	$n_dirs, $n_dirs / $d,
184	$n_files, $n_files / $d,
185	$n_stats, $n_stats / $d;
186	}
187
188	aioreq_pri -1;
189	++$n_dirs;
190	aio_scandir $path, 8, sub {
191	my ($dirs, $files) = @_
192	or return warn "$path: $!\n";
193
194	printfn "", [$path] unless $opt_nodirs;
195	printfn $path, $files unless $opt_nofiles;
196
197	$n_files += @$files;
198
199	if ($opt_stat) {
200	aio_wd $path, sub {
201	my $wd = shift;
202
203	aio_lstat [$wd, $_] for @$files;
204	$n_stats += @$files;
205	};
206	}
207
208	if ($opt_sync) {
209	aio_wd $path, sub {
210	my $wd = shift;
211
212	aio_pathsync [$wd, $_] for @$files;
213	aio_pathsync $wd;
214	};
215	}
216
217	push @todo, "$path$_"
218	for sort { $b cmp $a } @$dirs;
219	};
220	}
221
222	IO::AIO::max_outstanding 100; # two fds per directory, so limit accordingly
223	IO::AIO::min_parallel 20;
224
225	@todo = reverse @ARGV;
226
227	while () {
228	if (@todo) {
229	my $seed = pop @todo;
230	$seed =~ s/\/+$//;
231	aio_lstat "$seed/.", sub {
232	if ($_[0]) {
233	print STDERR "$seed: $!\n";
234	} elsif (-d _) {
235	scan $seed;
236	} else {
237	printfn "", $seed, "/";
238	}
239	};
240	} else {
241	IO::AIO::poll_wait;
242	}
243
244	last unless IO::AIO::nreqs;
245
246	IO::AIO::poll_cb;
247	}
248