#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my @path_in=qw(
  /data/bla1/ha1/hi1/he1
  /data/bla1/ha1/hi1/he2
  /data/bla1/ha1/hi2/he1
  /data/bla1/ha1/hi2/he2
  /data/bla1/ha2/hi1/he1
  /data/bla1/ha2/hi1/he2
  /data/bla1/ha2/hi2/he1
  /data/bla1/ha2/hi2/he2
  /data/bla2/ha1/hi1/he1
  /data/bla2/ha1/hi1/he2
  /data/bla2/ha1/hi2/he1
  /data/bla2/ha1/hi2/he2
  /data/bla2/ha2/hi1/he1
  /data/bla2/ha2/hi1/he2
  /data/bla2/ha2/hi2/he1
  /data/bla2/ha2/hi2/he2
);
print Dumper(\@path_in);

my $tree=make_tree(\@path_in);
print Dumper($tree);

my $path_out=join_tree($tree);
print Dumper($path_out);

########################################################################

sub make_tree
{
  my $tree={};

  add_to_tree($tree,$_) for(@{$_[0]});

  return $tree;
}

sub add_to_tree
{
  my $tree=shift;
  my $path=shift;
  my @elms=split('/',$path);

  # entferne am Anfang '/' wenn vorhanden
  shift(@elms) unless($elms[0]);

  # falls das letzte zeichen ein '/'
  # ist handelt es sich um ein verzeichnis
  my $file=1;
  unless($elms[-1])
  {
    $file=0;
    pop(@elms);
  }

  # Baum Eintrag erzeugen
  # vorsicht wenn verscht wird eine "Datei"
  # mit einem Ordner zu überschreiben kommt die Warnung
  # dass ein Scalar kein Hash ist.
  # umgehekhrt kann eine "Datei" aber einen ordner überschreiben.
  # wenn du das Abfangen willst/musst,
  # musst du das vor dem setzten prüfen
  my $ref=\$tree;
  $ref=\$$ref->{$_} for(@elms);

  # wert setzen
  # hier den übergeben pfad
  # kann aber jeder beliebige Wert sein
  $$ref=$path if($file);
}

sub join_tree
{
  my $tree=shift;
  my $path=shift // '';
  my @list;
  # alle namen der Ebenen durchgehen
  # sortiert zur hübscheren Darstellung
  for my $name (sort(keys(%$tree)))
  {
    my $elm=$tree->{$name};

    # wenn Hash, dann ist es ein Verzeichnis
    if($elm && ref($elm) eq 'HASH')
    {
      # rekursiver Aufruf
      # kann eine "deep Recursion" Warnung ausgeben
      # passiert bei tiefen wie man sie von Dateisystemen her kennt eher selten
      # je nach dem wie der Interpreter kompiliert wurde
      # kommt die Meldung nach 1.000 oder auch erst nach 1.000.000 Rekursionen
      # Dateisysteme haben aber selten mehr als 20 Ebenen.
      my $lst=join_tree($elm,"$path/$name");
      push(@list,@$lst);
    }
    else
    { push(@list,"$path/$name"); }
  }

  return \@list;
}