[ViewVC] Annotation 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.22
Committed:	Tue Sep 22 20:43:56 2026 UTC (6 days, 16 hours ago) by root
Branch:	MAIN
Changes since 1.21:	+16 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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	root	1.17	=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	root	1.19	-g, --grep=RE only list files that match the given perl RegEx
22	root	1.22	--quote shell quote when printing filenames
23	root	1.17
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	root	1.18	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	root	1.17
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	root	1.18	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	root	1.17
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	root	1.22	=item --quote
79
80			When printing filenames, shell-quote them.
81
82	root	1.17	=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	root	1.15	use common::sense;
107	root	1.1	use Getopt::Long;
108	root	1.10	use Time::HiRes ();
109	root	1.1	use IO::AIO;
110
111	root	1.3	our $VERSION = $IO::AIO::VERSION;
112	root	1.1
113	root	1.3	Getopt::Long::Configure ("bundling", "no_ignore_case", "require_order", "auto_help", "auto_version");
114
115	root	1.17	my ($opt_silent, $opt_print0, $opt_stat, $opt_nodirs, $opt_help,
116	root	1.22	$opt_nofiles, $opt_grep, $opt_progress, $opt_sync, $opt_shellquote);
117	root	1.1
118			GetOptions
119	root	1.10	"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	root	1.22	"quote" => \$opt_shellquote,
127	root	1.17	"sync" => \$opt_sync,
128			"help" => \$opt_help,
129	root	1.3	or die "Usage: try $0 --help";
130	root	1.1
131	root	1.17	if ($opt_help) {
132			require Pod::Usage;
133
134			Pod::Usage::pod2usage (
135			-verbose => 1,
136			-exitval => 0,
137			);
138			}
139
140	root	1.1	@ARGV = "." unless @ARGV;
141
142	root	1.20	my @todo; # list of dirs/files still left to scan
143
144	root	1.5	$opt_grep &&= qr{$opt_grep}s;
145
146	root	1.10	my ($n_dirs, $n_files, $n_stats) = (0, 0, 0);
147	root	1.13	my ($n_last, $n_start) = (Time::HiRes::time) x 2;
148	root	1.10
149	root	1.1	sub printfn {
150	root	1.2	my ($prefix, $files, $suffix) = @_;
151	root	1.1
152	root	1.5	if ($opt_grep) {
153			@$files = grep "$prefix$_" =~ $opt_grep, @$files;
154			}
155
156	root	1.1	if ($opt_print0) {
157	root	1.2	print map "$prefix$_$suffix\0", @$files;
158	root	1.22	} 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	root	1.1	} elsif (!$opt_silent) {
168	root	1.2	print map "$prefix$_$suffix\n", @$files;
169	root	1.1	}
170			}
171
172			sub scan {
173			my ($path) = @_;
174
175	root	1.2	$path .= "/";
176
177	root	1.9	IO::AIO::poll_cb;
178
179	root	1.10	if ($opt_progress and $n_last + 1 < Time::HiRes::time) {
180			$n_last = Time::HiRes::time;
181	root	1.14	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	root	1.17	$n_stats, $n_stats / $d;
186	root	1.10	}
187
188	root	1.2	aioreq_pri -1;
189	root	1.10	++$n_dirs;
190	root	1.1	aio_scandir $path, 8, sub {
191	root	1.9	my ($dirs, $files) = @_
192	root	1.16	or return warn "$path: $!\n";
193	root	1.1
194	root	1.3	printfn "", [$path] unless $opt_nodirs;
195			printfn $path, $files unless $opt_nofiles;
196	root	1.2
197	root	1.10	$n_files += @$files;
198
199	root	1.1	if ($opt_stat) {
200	root	1.6	aio_wd $path, sub {
201			my $wd = shift;
202
203			aio_lstat [$wd, $_] for @$files;
204	root	1.10	$n_stats += @$files;
205	root	1.6	};
206	root	1.1	}
207
208	root	1.17	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	root	1.20	push @todo, "$path$_"
218			for sort { $b cmp $a } @$dirs;
219	root	1.1	};
220			}
221
222	root	1.9	IO::AIO::max_outstanding 100; # two fds per directory, so limit accordingly
223	root	1.7	IO::AIO::min_parallel 20;
224	root	1.1
225	root	1.20	@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	root	1.1	}
248