Changed the buildthorns routine to return some info about a thorn.

BuildActiveThorns now adds comments to the ThornList.

Tom


git-svn-id: http://svn.cactuscode.org/flesh/trunk@1053 17b73243-c579-4c4c-a9d2-2d5706c11dac

3 files changed, 176 insertions, 49 deletions

diff --git a/lib/sbin/BuildActiveThorns.pl b/lib/sbin/BuildActiveThorns.pl
index d6f8ab8d..15fcb65a 100644
--- a/lib/sbin/BuildActiveThorns.pl
+++ b/lib/sbin/BuildActiveThorns.pl
@@ -13,5 +13,9 @@ require "lib/sbin/MakeUtils.pl";
 
 $package_dir = shift(@ARGV);
 
-&buildthorns($package_dir,"thorns");
+%info = &buildthorns($package_dir,"thorns");
 
+foreach $thorn (sort keys %info)
+{
+  printf("%-34s # %s\n",$thorn,$info{$thorn});
+}
diff --git a/lib/sbin/MakeUtils.pl b/lib/sbin/MakeUtils.pl
index 8d1ad07b..b8b5603b 100644
--- a/lib/sbin/MakeUtils.pl
+++ b/lib/sbin/MakeUtils.pl
@@ -21,77 +21,186 @@
 
 sub buildthorns
 {
-    local($package_dir,$choice) = @_;
-    local(@arrangements);
+  local($arrangement_dir,$choice) = @_;
+  local(@arrangements);
+  local(%info);
 
-    chdir $package_dir || die "Can't change directory to $package_dir\n";
+  chdir $arrangement_dir || die "Can't change directory to $arrangement_dir\n";
 
-    open(PACKAGES, "ls|");
+  open(ARRANGEMENTS, "ls|");
     
-    while(<PACKAGES>)
+  while(<ARRANGEMENTS>)
+  {
+    chop;
+
+    # Ignore CVS and backup stuff
+    next if (m:^CVS$:);
+    next if (m:^\#:);
+    next if (m:~$:);
+    next if (m:\.bak$:i);
+    next if (m:^\.:);
+    
+    # Just pick directories
+    if( -d $_)
+    {
+      push (@arrangements, $_);
+    }
+  }
+    
+  close ARRANGEMENTS;
+  
+  if ($choice =~ "thorns")
+  {
+    
+    foreach $arrangement (@arrangements)
     {
+      chdir $arrangement;
+      
+      open(THORNLIST, "ls|");
+      
+      while(<THORNLIST>)
+      {
 	chop;
-
+		
 	# Ignore CVS and backup stuff
 	next if (m:^CVS$:);
 	next if (m:^\#:);
 	next if (m:~$:);
 	next if (m:\.bak$:i);
 	next if (m:^\.:);
+		
+	# Allow each arrangement to have a documentation directory.
+	next if (m:^doc$:);
 	
 	# Just pick directories
 	if( -d $_)
 	{
-	    push (@arrangements, $_);
+	  push(@total_list, "$arrangement/$_");
 	}
+      }
+      chdir "..";
     }
     
-    close PACKAGES;
+  }
+  else
+  {
+    @total_list = @arrangements;
+  }
+ 
+  if($choice =~ "thorns")
+  {
+    foreach $thorn (@total_list)
+    {
+      if( -r "$thorn/interface.ccl" && -r "$thorn/param.ccl")
+      {
+	$info{$thorn} = &ThornInfo($thorn);
+      }
+#      print "$thorn \# $info{$thorn}\n";
+    }
+  }
+  else
+  {
+    foreach $arrangement (@total_list)
+    {
+      $info{$arrangement} = 1;
+    }
+  }
+
+  chdir "..";
+
+  return %info;
+}
+
+#/*@@
+#  @routine    ThornInfo
+#  @date       Sun Oct 17 15:57:44 1999
+#  @author     Tom Goodale
+#  @desc 
+#  Determines some info about a thorn.
+#  @enddesc 
+#  @calls     
+#  @calledby   
+#  @history 
+#
+#  @endhistory 
+#
+#@@*/
+sub ThornInfo
+{
+  local($thorn) = @_;
+  local($implementation) = "";
+  local($friends) = "";
+  local($inherits) = "";
+  local($shares) = "";
 
-    if ($choice =~ "thorns")
+  open(INTERFACE, "<$thorn/interface.ccl") || die "Unable to open $thorn/interface.ccl";
+
+  while(<INTERFACE>)
+  {
+    chop;
+    if (m/^\s*IMPLEMENTS:\s*([a-z]+[a-z_0-9]*)\s*$/i)
     {
-    
-	foreach $package (@arrangements)
-	{
-	    chdir $package;
-	    
-	    open(THORNLIST, "ls|");
-	    
-	    while(<THORNLIST>)
-	    {
-		chop;
-		
-		# Ignore CVS and backup stuff
-		next if (m:^CVS$:);
-		next if (m:^\#:);
-		next if (m:~$:);
-		next if (m:\.bak$:i);
-		next if (m:^\.:);
-		
-		# Allow each package to have a documentation directory.
-		next if (m:^doc$:);
-		
-		# Just pick directories
-		if( -d $_)
-		{
-		    push(@total_list, "$package/$_");
-		}
-	    }
-	    chdir "..";
-	}
-    
+      $implementation = $1;
+    }
+    elsif (m/^\s*INHERITS\s*:((\s*[a-zA-Z]+[a-zA-Z_0-9]*)*\s*)$/i)
+    {
+      $inherits = $1;
     }
-    else
+    elsif (m/^\s*FRIEND\s*:((\s*[a-zA-Z]+[a-zA-Z_0-9]*)*\s*)$/i)
     {
-	@total_list = @arrangements;
+      $friends = $1;
     }
+  }
 
-    foreach $thorn (@total_list)
+  close(INTERFACE);
+
+  open(PARAM, "<$thorn/param.ccl") || die "Unable to open $thorn/param.ccl";
+
+  while(<PARAM>)
+  {
+    chop;
+    if($line =~ m/SHARES\s*:(.*)/i)
     {
-	print "$thorn\n";
+      $share .= " $1";
     }
+  }
+
+  close(PARAM);
+
+  if($inherits =~ /^[\s\t\n]*$/)
+  {
+    $inherits = "(none)";
+  }
+  else
+  {
+    $inherits =~ s:^\s*::;
+    $inherits =~ s:\s*$::;
+    $inherits =~ s:[\s\t\n]+:,:g;
+  }
 
-    chdir "..";
+  if($friends =~ /^[\s\t\n]*$/)
+  {
+    $friends = "(none)";
+  }
+  else
+  {
+    $friends =~ s:^\s*::;
+    $friends =~ s:\s*$::;
+    $friends =~ s:[\s\t\n]+:,:g;
+  }
+  if($shares =~ /^[\s\t\n]*$/)
+  {
+    $shares = "(none)";
+  }
+  else
+  {
+    $shares =~ s:^\s*::;
+    $shares =~ s:\s*$::;
+    $shares =~ s:[\s\t\n]+:,:g;
+  }
+
+  return "Implements: $implementation Inherits: $inherits Friends: $friends Shares: $shares";
 }
 
+    
 1;
diff --git a/lib/sbin/checkout.pl b/lib/sbin/checkout.pl
index 63422d51..d271715d 100644
--- a/lib/sbin/checkout.pl
+++ b/lib/sbin/checkout.pl
@@ -72,12 +72,18 @@ while ()
 }
 
 sub get_arrangements
-{
-
+{   
+    local(%info);
+    local($arrangement);
     print "\nYou already have arrangements: \n\n";
 
-    &buildthorns("arrangements/","arrangements");
+    %info = &buildthorns("arrangements/","arrangements");
     
+    foreach $arrangement (sort keys %info)
+    {
+      print "$arrangement\n";
+    }
+
     print "\nAvailable arrangements: \n";
 
     open(MODULES,"cvs co -s | ");
@@ -145,10 +151,18 @@ sub get_arrangements
 
 sub get_thorns
 {
+    local(%info);
+    local($thorn);
+
     print "\nYou already have thorns: \n\n";
     
-    &buildthorns("arrangements/","thorns");
+    %info = &buildthorns("arrangements/","thorns");
     
+    foreach $thorn (sort keys %info)
+    {
+      print "$thorn\n";
+    }
+
     print "\nAvailable thorns: \n";
 
     open(MODULES,"cvs -q co -s | ");