[interchange-docs] xmldocs - docelic modified bin/stattree

docs at icdevgroup.org docs at icdevgroup.org
Sun Jun 18 20:15:59 EDT 2006


User:      docelic
Date:      2006-06-19 00:15:59 GMT
Modified:  bin      stattree
Log:
* Revert to 1.51

Revision  Changes    Path
1.53      +11 -68    xmldocs/bin/stattree


rev 1.53, prev_rev 1.52
Index: stattree
===================================================================
RCS file: /var/cvs/xmldocs/bin/stattree,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -r1.52 -r1.53
--- stattree	17 Jun 2006 19:37:25 -0000	1.52
+++ stattree	19 Jun 2006 00:15:59 -0000	1.53
@@ -573,12 +573,6 @@
 	if ( $c{file} eq 'lib/Vend/Config.pm' ) {
 		file_parseVendConfig(\%c, \@filedata);
 	}
-
-	####################################################################
-	# lib/Vend/Interpolate.pm
-	if ( $c{file} eq 'lib/Vend/Interpolate.pm' ) {
-		file_parseVendInterpolate(\%c, \@filedata);
-	}
 }
 
 # Format the context lines before saving to the db.
@@ -825,8 +819,8 @@
 
 		# Count braces
 		# If this code gets non-working for a particular case,
-		# add support for escapes (using negative lookbehind): (?<!\\)
-		# Or even, the code below in file_extractSub does have support for
+		# 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 );
@@ -835,10 +829,17 @@
 		if (! $opens) { # Have read the whole thing
 			$multiline = 0;
 
+			# Discover parse function for a directive
+			$directive =~ m/^\s*\['(.*?)',\s*'(.*?)',/s and
+				file_extractSub($1, "Vend::Config::parse_$2",
+						\%c, {group => $context,name=>$1});
+
 			# Register the directive and do some statistics
 			if ( $context eq 'globconf' ) {
+				push @globconf, [ $directive, $startline ] ;
 				$hash{total}{globconfs}++;
 			} elsif ( $context eq 'catconf' ){
+				push @catconf, [ $directive, $startline ];
 				$hash{total}{catconfs}++;
 			}
 			$hash{total}{confs}++;
@@ -862,7 +863,7 @@
 	# Well, let's congratulate ourselves.
 
 	for my $itm (@globconf) {
-		my ($ln, $lnum, $default) = @$itm;
+		my ($ln, $lnum) = @$itm;
 		$ln =~ /^\s*\['(\S+?)'/ or die "Can't match global directive name in '$ln'?\n";
 		push @{ $hash{symbols}{globconf}{$1} }, {
 			%c,
@@ -887,7 +888,7 @@
 		}
 	}
 	for my $itm (@catconf) {
-		my ($ln, $lnum, $default) = @$itm;
+		my ($ln, $lnum) = @$itm;
 		$ln =~ /^\s*\['(\S+?)'/ or die "Can't match catalog directive name in '$ln'?\n";
 		push @{ $hash{symbols}{catconf}{$1} }, {
 			%c,
@@ -904,64 +905,6 @@
 					ctx_n => 0,
 					%$spath,
 				};
-			}
-		}
-	}
-}
-
-# Parse Interpolate.pm and take out some great stuff ;-)
-sub file_parseVendInterpolate {
-	my %c = %{ (shift) };
-	my $content = shift; # Complete lib/Vend/Interpolate.pm file
-
-	my $linenr = -1;     # Increases as we parse Config.pm (search "MINUS" above)
-#	my $startline;       # Remember first line nr. of context, not last
-#	my $context = "";    # Globconf (global) or catconf (catalog) config array
-	my $run = 1;         # Engine turned on?
-#	my $multiline;       # Directive definition spans multiple lines?
-#	my $opens;           # Open brackets. When 0, complete directive is read
-	my $chunk;           # Chunk of whatever is multilined
-	my $tagname;         # Name of tag being processed
-
-	for my $line (@$content) {
-		$linenr++;
-
-		if ( $line =~ /^sub tag_(\w+) / and !$line =~ /^sub tag_(\w+) \{$/ ) {
-			warn "Tag $1 in Interpolate.pm doesn't have clean beginning.\n";
-		}
-
-		if ( $line =~ /^sub tag_(\w+) \{$/ ) {
-			$tagname = $1;
-			$c{fsubtype} = 'systemtag';
-
-			# Update source statistics
-			$hash{total}{$c{fsubtype} . "s"}++;
-			$hash{total}{tags}++;
-
-			file_extractSub($tagname, "Vend::Interpolate::tag_$tagname",
-					\%c, {group => $c{fsubtype},name=>$1});
-
-			push @{ $hash{symbols}{$c{fsubtype}}{$tagname} }, {
-				%c,
-				file => "$i{ver}/$c{file}",
-				lnum => scalar @{ $c{filedata}},
-				fsubtype => "systemtag",
-				ctx_p => $ctx_p,
-				ctx_n => $ctx_n,
-				ctxs => 1,
-				ctxe => scalar @{ $c{filedata}},
-				ctx => [ format_ctx(@{ $c{filedata}}) ]
-			};
-
-			# Push whole resolved chain; last item is actual function
-			if ( $resolver_path{$c{fsubtype}}{$tagname} ) {
-				while (my $spath=shift @{ $resolver_path{$c{fsubtype}}{$tagname}}){
-					push @{ $hash{symbols}{$c{fsubtype}}{$tagname} }, {
-						ctx_p => 0,
-						ctx_n => 0,
-						%$spath,
-					};
-				}
 			}
 		}
 	}








More information about the docs mailing list