Is there any module or any shohtcut to do this ?

Yup, File::Basename is what you're looking for. The idea is to strip off the last component of the path (by isolating the directory component) until you walk up high enough in the file system.

Note that I would have considered your example to start with 1. /, the root directory, but that's just me. Anyway, in a nutshell the code will look something like:

#! /usr/local/bin/perl

use strict;
use warnings;
use File::Basename 'dirname';

my $path = shift || '/usr/local/bin/perl';

my @ancestor;

while (1) {
    $path = dirname($path);
    last if $path eq '/';
    push @ancestor, "$path/";
}

print "$_\n" for reverse @ancestor;
[download]

What do you *really* want to do? What's the purpose? Maybe there's a better version than the simplistic approach:

 ...
 my $filename = '/usr/local/bin/perl';
 
 # get tree parts
 my @parts = $filename =~ m{ [^/]+ (?=/) }xg;
 
 # build tree
 for my $p (0 .. $#parts) {
    printf "%d. /%s/\n",  1+$p,  join('/', @parts[0..$p])
 }
 ...
[download]

Regards

mwa

(Jumpin' Jiminy--you sure post a lot!)

Here's another way to do it. (I just saw your question, and thought I'd try array slices to do the job.)

#!/usr/bin/perl -w
use strict;
use warnings;

my $fname = '/usr/local/bin/perl';
my @fname_parts = split /\//, $fname;

# Start at 1 to skip blank directory part (chunk before /usr),
# and @fname_parts-2 to leave off the final chunk (program name)
for my $i (1 .. @fname_parts-2) {
        print "$i. ", join('/', @fname_parts[0..$i]), "\n";
}
[download]

my $filename="/usr/local/bin/perl";
my $accu="";
my $nb=0;
map{$nb++;$accu.="/".$_;print "$nb. $accu\n";} split(/\//, $filename);
[download]

Or a recursive solution.....

use strict;
use warnings;
sub worker {
  my $dirsep = shift;
  worker ($dirsep, @_[0 .. $#_ - 1]) if ($#_ > 1); # terminator
  print join($dirsep, @_), "\n"
}
worker("/", split("/", "/usr/bin/foo/bar/baz"));
[download]

or an obfuscated solution:

 my  $filename = '/usr/local/bin/perl';

 open my $fh, '<', \$filename;
 local ($/,$\) = ('/')x2;
 /(?<=\w)\// && ($\.=$_) && print("\n".($.-1).'. ') while <$fh>;
[download]

Regards

mwa

while ( $filename =~ /(.+?\w+\/)/g ) {
    print $`, $1, $/;
}
[download]