[docs] xmldocs - docelic modified bin/stattree

[docs at icdevgroup.org]

User:      docelic
Date:      2004-10-12 18:09:31 GMT
Modified:  bin      stattree
Log:
Easy commit before I hit the town ;-)

- bin/stattree:
 - support for expanding MapRoutine into actual code is done. (Supports
   both case when it finds direct 'sub $func {', and when it finds
   *func = \&somewhere_else (which needs reiteration).

   So, the only thing left is making bin/refs-autogen read this and include
   in source context.

Revision  Changes    Path
1.26      +46 -23    xmldocs/bin/stattree


rev 1.26, prev_rev 1.25
Index: stattree
===================================================================
RCS file: /var/cvs/xmldocs/bin/stattree,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- stattree	12 Oct 2004 16:36:16 -0000	1.25
+++ stattree	12 Oct 2004 18:09:31 -0000	1.26
@@ -289,7 +289,6 @@
 
 			my %specific; # Item-specific data
 			my @tags; # Support multiple tags defined in the same file
-			my $maproutine; # Register if the tag MapRoutines, and to which func.
 
 			# This is where we parse the tag file. We should discover settings like
 			# HasEndTag, Order, and so on.
@@ -324,21 +323,10 @@
 					next;
 
 				} elsif ( $tagopt =~ /^maproutine$/i ) {
-					@lis == 1 and $maproutine = "@lis" or die 
-					"$tn MapRoutines, but argc != 1 ?\n";
 
+					@lis == 1 or die "$tn MapRoutines, but argc != 1 ?\n";
 					next if "@lis" =~ /^::/; # TODO
-
-					my @path = split /::/, "@lis";
-					my $func = pop @path;
-					my $path = join("/", @path) . ".pm";
-
-					open INF, "< lib/$path" or die "Can't open 'lib/$path' ($!)\n";
-					my @fc = <INF>;
-					close INF;
-
-					print "Checking $path\n";
-					file_extractSub($func, \@fc);
+					file_extractSub("@lis");
 				}
 				
 				if ( "@lis" =~ /<</ and $tagopt !~ /^routine/i ) {
@@ -567,6 +555,10 @@
 		next if $line =~ /^\s*#/;
 
 		# Count braces
+		# If this code gets non-working for a particular case,
+		# add support for escapes (negative lookbehind): (?<!\\)
+		# Or even more, the code below in file_extractSub has support for
+		# correcty parsing {\\} . Bleh ;-)
 		$opens += ( $line =~ s/([\(\[\{])/$1/g );
 		$opens -= ( $line =~ s/([\)\]\}])/$1/g );
 		$directive .= $line;
@@ -624,17 +616,48 @@
 
 
 sub file_extractSub {
-	my ($func, $fc) = @_;
+	my $func = shift;
 	my $done = 0;
+	$func or die "file_extractSub with no args?\n";
+	my $content;
+
+	my @path = split /::/, $func;
+	$func = pop @path;
+	my $path = join("/", @path) . ".pm";
+
+	open INF, "< lib/$path" or die "Can't open 'lib/$path' ($!)\n";
+	my @fc = <INF>;
+	close INF;
+
+	for ( my $i = 0; $i < @fc; $i++ ) {
+		my $line = $fc[$i];
+
+		if ( $line =~ /^\*$func = \\\&(\S+);/ ) {
+			#print "REPOINT TO $1\n";
+			my $repoint = ( file_extractSub( $1 ) );
+			return;
+
+		} elsif ( $line =~ /^sub $func {/ ) {
+			$content = $line;
+
+			# Quick and dirty extractor. This same functionality is in 
+			# file_parseVendConfig() above but is written too much purpose-specific
+			# to generalize it.
+			my $opens = 0;
+			for ( my $j = $i; $j < @fc; $j++) {
+				my $line2 = $fc[$j];
+				$opens += ( $line2 =~ s/(?<!(?<!\\)\\)([\(\[\{])/$1/g );
+				$opens -= ( $line2 =~ s/(?<!(?<!\\)\\)([\)\]\}])/$1/g );
+				$content .= $line2;
+				if ( !$opens) { $done++; last }
+			}
+
+			die "NOT FOUND FOR $func ?\n" unless $done;
+		}
+	}
 
-	#for my $line (@$fc) {
-	#	# Case1:
-	#	#/^sub $func {/;  # Extract this.
-	#	#
-	#	# Case2:
-	#	# /^\*func = \&Mod::Ule::func; # Follow and extract.
-	#}
+	return $content if wantarray;
 
-	#print "NOT FOUND FOR $func\n" unless $done;
+	$hash{functions}{$path}{$func} = [ split(/\n/, $content) ];
 }