add support for DUB packages locations in custom folders, close #234

src/ce_dubproject.pas

@@ -234,6 +234,59 @@ const
   dubCmd2PreMsg: array[TDubCommand] of string = ('compiling ', 'running ', 'testing ');
   dubCmd2PostMsg: array[TDubCommand] of string = ('compiled', 'executed', 'tested');
 
+procedure getPackagesLocations(loc: TStringList);
+var
+  p: string;
+  j: TJSONParser;
+  m: TMemoryStream;
+  a: TJSONArray;
+  o: TJSONObject = nil;
+  d: TJSONData;
+  r: TJSONData;
+  i: integer;
+begin
+  {$IFDEF WINDOWS}
+  p := GetEnvironmentVariable('APPDATA') + '\dub\packages\';
+  {$ELSE}
+  p := GetEnvironmentVariable('HOME') + '/.dub/packages/';
+  {$ENDIF}
+  if p.dirExists then
+    loc.Add(p);
+  p += 'local-packages.json';
+  if not p.fileExists then
+    exit;
+
+  m := TMemoryStream.Create;
+  try
+    m.LoadFromFile(p);
+    j := TJSONParser.Create(m, [joIgnoreTrailingComma, joUTF8]);
+    try
+      r := j.Parse;
+    finally
+      j.Free;
+    end;
+    if r.JSONType = jtArray then
+    begin
+      a := TJSONArray(r);
+      for i := 0 to a.Count-1 do
+      begin
+        o := a.Objects[i];
+        if not o.findAny('path', d) then
+          continue;
+        p := d.AsString;
+        if (p.length <> 0) and (p[p.length] <> DirectorySeparator) then
+          p += DirectorySeparator;
+        if DirectoryExistsUTF8(p) then
+          loc.Add(p);
+      end;
+    end;
+  finally
+    m.Free;
+    if r.isNotNil then
+      r.Free;
+  end;
+end;
+
 {$REGION TDubLocalPackages -----------------------------------------------------}
 constructor TDubLocalPackage.create;
 begin
@@ -320,23 +373,23 @@ end;
 procedure TDubLocalPackages.update;
 var
   p: TStringList;
+  r: TStringList;
   s: string;
   n: string;
   v: string = '';
   i: integer;
   j: integer = 0;
+  k: integer;
   d: PDubLocalPackage = nil;
   h: TStringRange = (ptr: nil; pos: 0; len: 0);
 begin
   setLength(fLocalPackages, 0);
-  {$IFDEF WINDOWS}
+  r := TStringList.Create;
-  fRoot := GetEnvironmentVariable('APPDATA') + '\dub\packages\';
+  getPackagesLocations(r);
-  {$ELSE}
-  fRoot := GetEnvironmentVariable('HOME') + '/.dub/packages/';
-  {$ENDIF}
-  if not fRoot.dirExists then
-    exit;
 
+  try for k := 0 to r.Count -1 do
+  begin
+    fRoot := r[k];
     p := TStringList.Create;
     try
       listFolders(p, fRoot);
@@ -377,6 +430,11 @@ begin
       p.Free;
     end;
   end;
+  finally
+    r.Free;
+  end;
+
+end;
 
 function TDubLocalPackages.find(const name: string; out package: PDubLocalPackage): boolean;
 var
@@ -1301,21 +1359,21 @@ procedure TCEDubProject.updateImportPathsFromJson;
     v: string;
     n: string;
     o: string;
-    z: string;
     r: TStringRange = (ptr: nil; pos: 0; len: 0);
     q: TSemVer;
     u: PSemVer;
     i: integer;
+    k: integer;
     c: TJSONObject;
+    b: TStringList;
   begin
     if obj.findObject('dependencies' + suffix, deps) then
     begin
-      {$IFDEF WINDOWS}
+
-      z := GetEnvironmentVariable('APPDATA') + '\dub\packages\';
+      b := TStringList.Create;
-      {$ELSE}
+      getPackagesLocations(b);
-      z := GetEnvironmentVariable('HOME') + '/.dub/packages/';
+
-      {$ENDIF}
+      try for i := 0 to deps.Count-1 do
-      for i := 0 to deps.Count-1 do
       begin
         n := deps.Names[i];
 
@@ -1330,7 +1388,6 @@ procedure TCEDubProject.updateImportPathsFromJson;
           continue;
         end;
 
-        s := z + n;
         // Try to fetch if not present at all
         if not fLocalPackages.find(n, pck) and dubBuildOptions.autoFetch then
         begin
@@ -1399,16 +1456,29 @@ procedure TCEDubProject.updateImportPathsFromJson;
           // Set the imports, used in particular by DCD
           if assigned(u) then
           begin
+            for k := 0 to b.Count-1 do
+            begin
+              s := b[k] + n;
               p :=  s + '-' + u^.asString + DirectorySeparator + n + DirectorySeparator;
               if (p + 'source').dirExists then
-              fImportPaths.Add(p + 'source')
+              begin
+                fImportPaths.Add(p + 'source')  ;
+                break;
+              end
               else if (p + 'src').dirExists then
+              begin
                 fImportPaths.Add(p + 'src');
+                break;
               end;
             end;
           end;
         end;
       end;
+      finally
+        b.Free;
+      end;
+    end;
+  end;
 
 var
   conf: TJSONObject;