From 099b60cfc8376454eed30db710260eaaa426211d Mon Sep 17 00:00:00 2001
From: mquinson <mquinson@48e7efb5-ca39-0410-a469-dd3cf9ba447f>
Date: Tue, 8 Feb 2005 12:03:50 +0000
Subject: [PATCH] Little script to extract the log categories from the source
 code and display them in a nice tree manner (I finally took the time to write
 it)

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/simgrid/simgrid/trunk@907 48e7efb5-ca39-0410-a469-dd3cf9ba447f
---
 src/xbt_log_extract_hierarchy | 114 ++++++++++++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100755 src/xbt_log_extract_hierarchy

diff --git a/src/xbt_log_extract_hierarchy b/src/xbt_log_extract_hierarchy
new file mode 100755
index 0000000000..7eabb2472b
--- /dev/null
+++ b/src/xbt_log_extract_hierarchy
@@ -0,0 +1,114 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+my $debug = 0;
+
+
+# Search for calls to macros defining new channels, and prepare the tree representation
+my %ancestor;
+my %desc;
+# $ancestor{"toto"} is the ancestor of the toto channel
+# $desc{"toto"} is its description
+
+sub parse_file {
+    my $filename = shift;
+    
+    my $data = "";
+    
+    print "Parse $filename\n" if $debug;
+    open IN, "$filename" || die "Cannot read $filename: $!\n";
+    while (<IN>) {
+	$data .= $_;
+    }
+    close IN;
+
+    # Purge $data from C comments
+    $data =~ s|/\*.*?\*/||sg;
+
+    # C++ comments are forbiden in SG for portability reasons, but deal with it anyway
+    $data =~ s|//.*$||mg;
+
+    while ($data =~ s/^.*?XBT_LOG_NEW(_DEFAULT)?_(SUB)?CATEGORY\(//s) {
+	$data =~ s/([^"]*"[^"]*")\)//s || die "unparsable macro: $data"; # ]]);
+	my $ctn = $1;
+    
+        # cleanup the content											 
+	$ctn =~ s/ *\n//gs;										 
+        $ctn =~ s/,\s*"/,"/gs;
+        $ctn =~ s/"\s*$/"/gs;
+        $ctn =~ s/,\s*/,/gs;
+        my @elms_tmp=split (/,/,$ctn); 
+        my @elms;
+        print "ctn=$ctn\n" if $debug > 1;
+        # There may be some ',' in the description. Remerge the stuff like: "description, really"
+        while (1) {
+	    my $acc = shift @elms_tmp;
+	    last unless defined $acc;
+  	    if ($acc =~ /^"/) { # ") {
+	        while (shift @elms_tmp) { 
+		   $acc .= $_;
+ 	        }
+	        die "Unparsable content: $ctn\n"
+	           unless ($acc =~ s/^"(.*)"$/$1/);
+	    }
+	    print "  seen $acc\n" if $debug > 1;
+	    push @elms, $acc;
+        }
+
+        my ($name,$anc,$desc);
+        # build the tree, checking for name conflict
+        if (scalar(@elms) eq 3) {
+	   $name = $elms[0];
+	   $anc  = $elms[1];
+	   $desc = $elms[2];
+        } elsif (scalar(@elms) eq 2) {
+	   $name = $elms[0];
+	   $anc  = "XBT_LOG_ROOT_CAT";
+	   $desc = $elms[1];
+        } else {
+	   my $l = scalar(@elms);
+	   my $s = "";
+	   map {$s .= $_;} @elms;
+	   die "Unparsable content: $ctn (length=$l) (content=$s)\n";
+        }
+	$name =~ s/^\s*(\S*)\s*$/$1/; # trim
+	$anc  =~ s/^\s*(\S*)\s*$/$1/; # trim
+        die "ERROR: Category name conflict: $name used several times\n"
+	   if defined ($ancestor{$name}) && $ancestor{$name} ne $anc &&
+              defined ($desc{$name}) && $desc{$name} ne $desc;
+       $ancestor{$name}=$anc;
+       $desc{$name}=$desc;
+   
+       print " $name -> $anc\n" if $debug;
+   }
+}
+# Retrieve all the file names, and add their content to $data
+my $data;
+open FILES, "find -name '*.c'|" || die "Cannot search for the source file names; $!\n";
+while (my $file=<FILES>) {
+    chomp $file;
+    parse_file($file); 	
+}
+close FILES;
+
+# Display the tree, looking for disconnected elems    
+my %used;
+    
+sub display_subtree {
+    my $name=shift;
+    my $indent=shift;
+    
+    $used{$name} = 1;
+    unless ($name eq "XBT_LOG_ROOT_CAT") { # do not display the root
+	print "$indent - $name: ".($desc{$name}|| "(undocumented)")."\n";
+    }
+    foreach my $cat (grep {$ancestor{$_} eq $name} sort keys %ancestor) {
+	display_subtree($cat,"$indent  ");
+    }
+}
+    
+display_subtree("XBT_LOG_ROOT_CAT","");
+
+map {warn "Category $_ does not seem to be connected to the root (anc=$ancestor{$_})\n";} grep {!defined $used{$_}} sort keys %ancestor;    
-- 
2.20.1