root/library/doc/toolbox_doc/class_hierarchy.pl @ 988

#!/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 "==Hierarchy";
#print_class($classes_hier, 0);
#
#print "\n==List\n";
#map { print "$_\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;

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