Finding website paths for Drupal modules

As part of my side projects, I have been helping a friend move his Drupal 8 website from a proof of concept towards going live. One of the problems I was facing was how modules map to URLs so I wrote a little Perl script to generate a URL tree from module routing files.

tree_routes.pl

#!/usr/bin/perl

use strict;
use warnings;
use diagnostics;

use YAML::Tiny;
use Data::Dumper;
use Tree::DAG_Node;

# Nice Tree
{
   package NiceTree;
   use Tree::DAG_Node;
   our @ISA = qw(Tree::DAG_Node);

   sub new {
      my $class = shift;
      my $options = shift;
      my $self = bless $class->SUPER::new($options);
      return $self;
   }

   sub hashref2string {
      my ($self, $hashref) = @_;
      $hashref ||= {};
      return join(", ", map {qq|$_ => "$$hashref{$_}"|} sort keys %$hashref);
   }

   sub format_node {
      my ($self, $options, $node) = @_;
      my ($s) = $node->name;

      if (keys %{ $node->attributes } > 0) {
         $s .= "\t" . $self->hashref2string($node->attributes) if (!$$options{no_attributes});
      }

      return $s;
   }

   sub node2string {
      my ($self, $options, $node, $vert_dashes) = @_;
      my ($depth) = scalar($node->ancestors) || 0;
      my ($sibling_count) = defined $node->mother ? scalar $node->self_and_sisters : 1;
      my ($offset) = ' ' x 3;
      my (@indent) = map {$$vert_dashes[$_] || $offset} 0 .. $depth - 1;
      @$vert_dashes =
         (
            @indent,
            ($sibling_count == 1 ? $offset : '  |'),
         );

      if ($sibling_count == ($node->my_daughter_index + 1)) {
         $$vert_dashes[$depth] = $offset;
      }

      my $x = ((scalar($node->daughters) || 0) ? '  |--+ ' : '  |--- ');

      return join('' => @indent[1 .. $#indent]) . ($depth ? $x : '') . $self->format_node($options, $node);

   }
}

# Find files in path
{
   my @paths;
   sub dir_listing {
      my ($root) = @_;
      $root .= '/' unless $root =~ /\/$/;
      for my $f (glob "$root*") {
         push @paths, $f;
         dir_listing($f) if -d $f;
      }
      return @paths;
   }
}

# Generate tree of URLs
{
   my $path_tree = NiceTree->new({ name => '/' });
   # my $path_tree = Tree::DAG_Node->new({ name => '/' });

   sub add_node {
      my ($current_node, $leaf) = @_[0, 1];

      my $new_daughter = $current_node->new_daughter({ name => $leaf });

      # Keep daughters in alphabetical order
      $current_node->set_daughters(sort {$a->name cmp $b->name} $current_node->daughters);

      return $new_daughter;
   }

   sub get_node_for_path {
      my @paths = split '/', $_[0];

      my $current_node = $path_tree; # Start at the root

      foreach my $leaf (@paths) {
         if ($leaf ne '') {
            my $found = 0;
            my @daughters = $current_node->daughters();

            if (@daughters) {
               foreach my $dau (@daughters) {
                  if ($dau->name eq $leaf) {
                     $current_node = $dau;
                     $found = 1;
                     last;
                  }
               }
            }

            if (not $found) {
               $current_node = add_node($current_node, $leaf);
            }
         }
      }

      return $current_node;
   }
}


sub process_requirements {
   my %requirements = @_;
   my $path_node = $requirements{'path_node'};

   if (defined $requirements{'_permission'}) {
      $path_node->attributes->{'Permission'} = $requirements{'_permission'};
   }

   if (defined $requirements{'_entity_access'}) {
      $path_node->attributes->{'Access'} = $requirements{'_entity_access'};
   }
}


sub process_defaults {
   my %defaults = @_;

   my $path_node = $defaults{'path_node'};

   if (defined $defaults{'_title'}) {
      $path_node->attributes->{Title} = $defaults{'_title'};
   }

   if (defined $defaults{'_controller'}) {
      $path_node->attributes->{'Controller'} = $defaults{'_controller'};
   }

   if (defined $defaults{'_entity_form'}) {
      $path_node->attributes->{'Entity_form'} = $defaults{'_entity_form'};
   }

   if (defined $defaults{'_entity_list'}) {
      $path_node->attributes->{'Entity_list'} = $defaults{'_entity_list'};
   }
}


sub process_form {
   my %form = @_;

   my $filename = $form{'filename'};
   my $formname = $form{'formname'};
   my $path = $form{'path'};

   my $node = get_node_for_path($path);

   $node->attributes->{'Form'} .= $formname . ";";
   $node->attributes->{'File'} .= $filename . ";";

   process_defaults(%{$form{'defaults'}}, path_node => $node);
   process_requirements(%{$form{'requirements'}}, path_node => $node);
}


sub process_yml_file {
   my $filename = $_[0];
   my $yaml = YAML::Tiny->read($filename);

   # print "File: @_\n";
   if (defined $yaml->[0]) {

      my %k = %{$yaml->[0]};
      # print Dumper(%k);

      for my $form (keys %k) {
         if ($form ne '') {
            if (ref($k{$form}) eq 'HASH') {
               process_form(%{$k{$form}}, filename => $filename, formname => $form);
            }
            else {
               warn("Form: $form in file $filename is " . ref($k{$form}) . "\n");
            }
         }
      }
   }
   else {
      warn("yaml file $filename is empty\n");
   }
}


my @paths = dir_listing(@ARGV);

foreach my $file (@paths) {
   if ($file =~ /\.routing\.yml$/) {
      eval {
         process_yml_file($file)
      };
      if ($@ ne '') {
         warn("Error caught while processing file $file\n");
         warn(@$);
      }

   }
}

my $tree = get_node_for_path('/');
print "Tree is:\n";
print map("$_\n", @{$tree->tree2string});