use strict;
use warnings;

my @levels = '.';
while (<DATA>) {
    chomp;
    my ($prefix, $node) = split(/(?<=-- )/, $_, 2);
    my $level = length($prefix)/2-1;
    $levels[$level] = "$levels[$level-1]/$node";
    print("$prefix$levels[$level]\n");
}

__DATA__
|-- DIR_COLORS
|-- X11
| |-- WindowMaker
| | |-- WMGLOBAL
| | `-- WindowMaker
| |-- XF86Config
| |-- Xresources
| |-- Xsession
| |-- app-defaults
| | |-- Beforelight
| | |-- Bitmap
| | `-- Xvidtune
| |-- glx.conf
| |-- lbxproxy
| | `-- AtomControl
|-- xinetd.conf
|-- xinetd.d
| |-- cups-lpd
| |-- cvs
| |-- fam
| |-- proftpd-xinetd
| |-- rsync
| `-- sshd-xinetd
|-- xml
| `-- catalog
`-- xpdfrc
[download]

|-- ./DIR_COLORS
|-- ./X11
| |-- ./X11/WindowMaker
| | |-- ./X11/WindowMaker/WMGLOBAL
| | `-- ./X11/WindowMaker/WindowMaker
| |-- ./X11/XF86Config
| |-- ./X11/Xresources
| |-- ./X11/Xsession
| |-- ./X11/app-defaults
| | |-- ./X11/app-defaults/Beforelight
| | |-- ./X11/app-defaults/Bitmap
| | `-- ./X11/app-defaults/Xvidtune
| |-- ./X11/glx.conf
| |-- ./X11/lbxproxy
| | `-- ./X11/lbxproxy/AtomControl
|-- ./xinetd.conf
|-- ./xinetd.d
| |-- ./xinetd.d/cups-lpd
| |-- ./xinetd.d/cvs
| |-- ./xinetd.d/fam
| |-- ./xinetd.d/proftpd-xinetd
| |-- ./xinetd.d/rsync
| `-- ./xinetd.d/sshd-xinetd
|-- ./xml
| `-- ./xml/catalog
`-- ./xpdfrc
[download]

I would think
print("$levels[$level]\n");
would make more sense than
print("$prefix$levels[$level]\n");
but I gave you what you asked for.

my @path;

while (<DATA>)
{
    chomp();
    /^((?:\| )*[|`]-- )(.+)/ or next;
    $#path = length($1)/2 - 3; # truncate path based on tree level
    push(@path, $2);
    print $1, "./", join("/" => @path), "\n";
}
[download]

Why set the length of the array only to change it immediately? I also hate the needless use of global vars.

my @path = '.';
while (<DATA>) {
    chomp;
    my ($prefix, $node) = /^((?:\| )*[|`]-- )(.+)/
        or next;
    $#path = length($prefix)/2 - 1;
    $path[-1] = $node;
    print $prefix, join("/" => @path), "\n";
}
[download]

Alternative, we could use splice.

my @path = '.';
while (<DATA>) {
    chomp;
    my ($prefix, $node) = /^((?:\| )*[|`]-- )(.+)/
        or next;
    splice @path, length($prefix)/2-1, 0+@path, $node;
    print $prefix, join("/" => @path), "\n";
}
[download]

It avoids the addition of magic to @path, and it combines two operations. The latter usually makes something more readable, but it's unfortunately not the case here.

Speaking of readability, that regex is rather hard to read. I had something like that initially, but I switched to split because it was much more straightforward.

my @path = '.';
while (<DATA>) {
    chomp;
    my ($prefix, $node) = split(/(?<=-- )/, $_, 2)
        or next;
    $#path = length($prefix)/2 - 1;
    $path[-1] = $node;
    print $prefix, join("/" => @path), "\n";
}
[download]

Why set the length of the array only to change it immediately?

It was one way to do it. The goal was to keep @path with only "pure" node information, and not have redundancies like ".", "/", and previous nodes repeated as the indexes go higher.


I also hate the needless use of global vars.

Me too. But a data structure outside the loop was needed to oversee things.

Thanks for your efforts ikegami (Apostle) and repellent (Chaplain)

Awesome!!

worked on 70,000 line backup text file

I used

my @path = '.';

while (<STDIN>) {

chomp;

my ($prefix, $node) = /^((?:\| )*`-- )(.+)/

or next;

$#path = length($prefix)/2 - 1;

$path-1 = $node;

# print $prefix, join("/" => @path), "\n";

print join("/" => @path), "\n";

}

ikegami yes, I didn't want prefix printed