root/applications/bdmtoolbox/doc/from_bdm/class_hierarchy.pl @ 1065

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Getopt::Long;

my $GIVEN_CLASS = 'bdm::DS';
GetOptions(
    'class=s'   => \$GIVEN_CLASS,
) or die('Wrong options format');

my $prev_class = {
    name        => '',
    daughters   => [],
};
$prev_class->{parent} = $prev_class;

my $class;

my $prev_indent = 0;
my $indent;

my $classes_list = {};
my $classes_hier = $prev_class;

while (my $line = <>) {
    # parse the current line
    chomp $line;
    $line =~ m{ 
        ^       # start of the line
        ([ ]+)  # indentation
        (.+)    # class name itself
        $       # end of the line
    }xms;
    $indent        = length $1; # number of indent spaces
    my $class_name = $2;        # the rest of the line

    # find the parent class: this simple while covers all situations
    while ($indent <= $prev_indent) {
        $prev_class = $prev_class->{parent};
        $prev_indent--;
    }

    $class = {
        name      => $class_name,
        daughters => [],
        parent    => $prev_class,
    };

    push @{ $prev_class->{daughters} }, $class; # place into the hierarchy
    $classes_list->{$class_name}      = $class; # store in hash by name
    
    # store current values as previous for the next iteration
    $prev_indent = $indent;
    $prev_class  = $class;
}

print STDERR "==Hierarchy";
print_class($classes_hier, 0, *STDERR);

print STDERR "\n==List\n";
map { print STDERR "$_\n" } sort keys %{ $classes_list };

#print "\n==Given\n";
print_class($classes_list->{$GIVEN_CLASS}, 0);

sub print_class {
    my $class  = shift;
    my $indent = shift;
    my $out = shift || *STDOUT;

    print $out " " x $indent;
    print $out $class->{name}, "\n";
    
    map { print_class($_, $indent+1, $out) }  @{ $class->{daughters} };
}