1 1ddd2d4e 2023-09-10 jrmu #!/usr/bin/perl
 2 1ddd2d4e 2023-09-10 jrmu 
 3 1ddd2d4e 2023-09-10 jrmu # Modify the iterative version of data_for_path to handle both depth-first or
 4 1ddd2d4e 2023-09-10 jrmu # breadth-first traversal. Use an optional third argument to allow the user
 5 1ddd2d4e 2023-09-10 jrmu # to decide which to use:
 6 1ddd2d4e 2023-09-10 jrmu 
 7 1ddd2d4e 2023-09-10 jrmu #my $depth = data_for_path( $start_dir, $threshold, 'depth-first');
 8 1ddd2d4e 2023-09-10 jrmu #my $breadth = data_for_path( $start_dir, $threshold, 'breadth-first');
 9 1ddd2d4e 2023-09-10 jrmu 
10 1ddd2d4e 2023-09-10 jrmu use v5.24;
11 1ddd2d4e 2023-09-10 jrmu use warnings;
12 1ddd2d4e 2023-09-10 jrmu use strict;
13 1ddd2d4e 2023-09-10 jrmu use utf8;
14 1ddd2d4e 2023-09-10 jrmu use File::Basename;
15 1ddd2d4e 2023-09-10 jrmu use File::Spec::Functions;
16 1ddd2d4e 2023-09-10 jrmu 
17 1ddd2d4e 2023-09-10 jrmu sub data_for_path {
18 1ddd2d4e 2023-09-10 jrmu 	my ($path, $threshold, $order) = @_;
19 1ddd2d4e 2023-09-10 jrmu 	my $data = {};
20 1ddd2d4e 2023-09-10 jrmu 	my @queue = ( [$path, 0, $data] );
21 1ddd2d4e 2023-09-10 jrmu 	while (my $next = shift @queue) {
22 1ddd2d4e 2023-09-10 jrmu 		my ($path, $level, $ref) = @$next;
23 1ddd2d4e 2023-09-10 jrmu 		my $basename = basename($path);
24 1ddd2d4e 2023-09-10 jrmu 		$ref->{$basename} = do {
25 1ddd2d4e 2023-09-10 jrmu 			if (-f $path or -l $path) { undef }
26 1ddd2d4e 2023-09-10 jrmu 			else {
27 1ddd2d4e 2023-09-10 jrmu 				my $hash = {};
28 1ddd2d4e 2023-09-10 jrmu 				if ($level < $threshold) {
29 1ddd2d4e 2023-09-10 jrmu 					opendir(my $dh, $path);
30 1ddd2d4e 2023-09-10 jrmu 					my @new_paths = map {
31 1ddd2d4e 2023-09-10 jrmu 						catfile($path, $_);
32 1ddd2d4e 2023-09-10 jrmu 					} grep { ! /^\.\.?\z/ } readdir $dh;
33 1ddd2d4e 2023-09-10 jrmu 					if ($order eq 'breadth-first') {
34 1ddd2d4e 2023-09-10 jrmu 						unshift @queue, map { [$_, $level+1, $hash] } @new_paths;
35 1ddd2d4e 2023-09-10 jrmu 					} elsif ($order eq 'depth-first') {
36 1ddd2d4e 2023-09-10 jrmu 						push @queue, map { [$_, $level+1, $hash] } @new_paths;
37 1ddd2d4e 2023-09-10 jrmu 					}
38 1ddd2d4e 2023-09-10 jrmu 				}
39 1ddd2d4e 2023-09-10 jrmu 				$hash;
40 1ddd2d4e 2023-09-10 jrmu 			}
41 1ddd2d4e 2023-09-10 jrmu 		};
42 1ddd2d4e 2023-09-10 jrmu 	}
43 1ddd2d4e 2023-09-10 jrmu 	$data;
44 1ddd2d4e 2023-09-10 jrmu }
45 1ddd2d4e 2023-09-10 jrmu 
46 1ddd2d4e 2023-09-10 jrmu sub dump_data_for_path {
47 1ddd2d4e 2023-09-10 jrmu 	my ($path, $data, $level) = @_;
48 1ddd2d4e 2023-09-10 jrmu 	if (not defined $data) {
49 1ddd2d4e 2023-09-10 jrmu 		print "$path\n";
50 1ddd2d4e 2023-09-10 jrmu 		return;
51 1ddd2d4e 2023-09-10 jrmu 	}
52 1ddd2d4e 2023-09-10 jrmu 	foreach (sort keys %$data) {
53 1ddd2d4e 2023-09-10 jrmu 		dump_data_for_path("$path/$_", $data->{$_});
54 1ddd2d4e 2023-09-10 jrmu 	}
55 1ddd2d4e 2023-09-10 jrmu }
56 1ddd2d4e 2023-09-10 jrmu my $start_dir = '/home/jrmu/documents';
57 1ddd2d4e 2023-09-10 jrmu my $threshold = 3;
58 1ddd2d4e 2023-09-10 jrmu my $depth = data_for_path( $start_dir, $threshold, 'depth-first');
59 1ddd2d4e 2023-09-10 jrmu my $breadth = data_for_path( $start_dir, $threshold, 'breadth-first');