[Gd-chatter] r11461 - trunk/fundev/admin/builds

[housel at gwydiondylan.org]

Author: housel
Date: Thu Sep 27 15:12:09 2007
New Revision: 11461

Modified:
   trunk/fundev/admin/builds/fdmake.pl
Log:
Bug: 7360
Support multiple path components in OPEN_DYLAN_USER_REGISTRIES.

* admin/builds/fdmake.pl (build_library): Split $user_registries
  on the platform-specific path separator, try each registry in turn,
  and base LID file and source path names on the location of the
  registry where the library was found.


Modified: trunk/fundev/admin/builds/fdmake.pl
==============================================================================
--- trunk/fundev/admin/builds/fdmake.pl	(original)
+++ trunk/fundev/admin/builds/fdmake.pl	Thu Sep 27 15:12:09 2007
@@ -4,6 +4,7 @@
 use File::Spec;
 use Getopt::Long;
 use XML::Parser;
+use Config;
 
 my $lidfile_line;
 
@@ -58,19 +59,35 @@
 
     return $built{$library} if exists $built{$library};
 
-    open(REGISTRY, '<', "$user_registries/$platform_name/$library")
-	|| open(REGISTRY, '<', "$user_registries/generic/$library")
-	|| return 0;
-    my $line = <REGISTRY>;
-    close(REGISTRY);
-
-
-    # abstract://dylan/environment/console/minimal-console-compiler.lid
-    $line =~ s|^abstract://dylan/||;
-    my ($dir, $lidfile) = ($line =~ m|(.*)/(.*)|);
+    my $separator = quotemeta(($Config{'osname'} eq 'MSWin32') ? ';' : ':');
+    my $lidfile;
+    my $dir;
+  REGISTRY:
+    foreach my $registry (split /$separator/, $user_registries) {
+	open(REGISTRY, '<', "$registry/$platform_name/$library")
+	    || open(REGISTRY, '<', "$registry/generic/$library")
+	    || next REGISTRY;
+	my $line = <REGISTRY>;
+	close(REGISTRY);
+
+	my ($volume, $directories, undef) = File::Spec->splitpath($registry, 1);
+	my @directories = File::Spec->splitdir($directories);
+
+	lc(pop(@directories)) eq 'registry' or die;
+
+	# abstract://dylan/environment/console/minimal-console-compiler.lid
+	$line =~ s|^abstract://dylan/||;
+	($dir, $lidfile) = ($line =~ m|(.*)/(.*)|);
+	push @directories, File::Spec::Unix->splitdir($dir);
+	$dir = File::Spec->catpath($volume,
+				   File::Spec->catdir(@directories), '');
+	$lidfile = File::Spec->catfile($dir, $lidfile);
+	last REGISTRY;
+    }
 
-    $dir = File::Spec->catdir($user_sources, $dir);
-    $lidfile = File::Spec->catfile($dir, $lidfile);
+    if (!defined $lidfile) {
+	return 0;
+    }
 
     my $header = &parse_lid_file($lidfile);