Item13135: Somewhat better version, but much more to do

foswiki · Feb 20, 2015 · 46f2556 · 46f2556
1 parent 854ebcc
commit 46f2556
Showing 1 changed file with 32 additions and 78 deletions.
diff --git a/core/tools/git_excludes.pl b/core/tools/git_excludes.pl
@@ -18,19 +18,20 @@
 BEGIN {
     my ( $volume, $toolsDir, $action ) = File::Spec->splitpath(__FILE__);
     $toolsDir = '.' if $toolsDir eq '';
-    ($toolsDir) = Cwd::abs_path( $toolsDir ) =~ /(.*)/;
-    @INC = ($toolsDir, grep { $_ ne $toolsDir } @INC );
+    ($toolsDir) = Cwd::abs_path($toolsDir) =~ /(.*)/;
+    @INC = ( $toolsDir, grep { $_ ne $toolsDir } @INC );
     my $binDir = Cwd::abs_path( File::Spec->catdir( $toolsDir, "..", "bin" ) );
     $distro = Cwd::abs_path( File::Spec->catdir( $toolsDir, "..//..", "" ) );
-    my ($setlib) = File::Spec->catpath( $volume, $binDir, 'setlib.cfg' ) =~ /(.*)/;
+    my ($setlib) =
+      File::Spec->catpath( $volume, $binDir, 'setlib.cfg' ) =~ /(.*)/;
     require $setlib;
 }
 
 sub slurp {
     my $file = shift;
 
-    # OK to return '' if file does not exist,
-    # but what if its another error? - probably OK as later write will fail anyway
+  # OK to return '' if file does not exist,
+  # but what if its another error? - probably OK as later write will fail anyway
     open my $fh, '<', $file or return '';
 
     local $/ = undef;
@@ -39,95 +40,48 @@ sub slurp {
     return $cont;
 }
 
-sub mergeB {
-    my ( $bRef, $tag, $desc, @ignores) = @_;
-
-}
-sub writeB {
-    my ( $fh, $bRef );
-}
-
 sub recurseDirectories {
-    my ($dir, $sub) = @_;
+    my ( $dir, $sub ) = @_;
 
-    my @dirs = ( glob("$dir/*") , glob("$dir/.*") );
+    my @dirs = ( glob("$dir/*"), glob("$dir/.*") );
 
-    for my $f (sort @dirs) {
-	next if $f =~ m{.*?/\.{1,2}$};
-        &$sub( $f );
-        recurseDirectories($f, $sub) if -d $f && !-l $f;
+    for my $f ( sort @dirs ) {
+        next if $f =~ m{.*?/\.{1,2}$};
+        &$sub($f);
+        recurseDirectories( $f, $sub ) if -d $f && !-l $f;
     }
 }
 
-chdir($distro);
-my $excludes = slurp(".git/info/excludes");
-
-my %block = ( $excludes =~ m/(?:\s*+\#\#Begin)\s*(\w+)\s+(.*?)(?:\n\#\#End)/gms );
-my @dirs = glob('*');
-
 my @symlinks;
-#my @nonDistroExtensions;
 
-#for my $d (sort @dirs) {
-#    push @nonDistroExtensions, "/$d/" if -d $d;
-#    push @symlinks, "/$d" if -l $d;
-#}
+recurseDirectories(
+    $distro,
+    sub {
+        my $link = $_[0];
+        $link =~ s/^$distro//;
+        push @symlinks, $link if -l $_[0];
+    }
+);
 
-recurseDirectories($distro, sub { push @symlinks, $_[0] if -l $_[0]; } );
+mkdir("$distro/gitexcludes");
+open( my $symFH, '>' . "$distro/gitexcludes/symlinks" );
 
 {
     local $" = "\n";
-    print "@symlinks";
+    print $symFH "@symlinks\n";
 }
-exit 0;
-
-# mergeB(\%block, "Extra-Extensions", "Non Default Foswiki Extensions (are independently git managed)", @nonDistroExtensions);
-# mergeB(\%block, "Symlinks", "These are BuildContrib outputs and never part of a Foswiki repo", @symlinks);
-
-writeB(\%block);
 
-$excludes = <<'HERE';
-##Begin Developer Your own local ignores
-What
-Ever
-Whims
-y like
-yall
-##End
+close($symFH);
 
-##Begin Symlinks These are BuildContrib outputs and never part of a Foswiki repo
-a
-b
-cv
-d
-##End
+my @ignores = glob("$distro/gitexcludes/*");
 
-##Begin Extra_Extensions Pseudo-Installed extensions under their own .git control
-1
-2
-3
-##End
-
-##Begin Symlinks These are logically build outputs and never part of a Foswiki repo
-za
-zb
-zcv
-zd
-##End
-
-
-HERE
-
-# print "$excludes";
-
-
-%block = ( $excludes =~ m/(?:\s*+\#\#Begin)\s*(\w+)\s+(.*?)(?:\n\#\#End)/gms );
-
-for my $tag (sort keys %block) {
-    print "(($tag))\n";
-    print $block{$tag};
-    print "\n-------\n";
+my $out = undef;
+for my $f ( sort @ignores ) {
+    $out .= slurp("$f");
 }
 
-exit 0;
+open( my $info_exclude, '>', "$distro/.git/info/exclude" );
+print $info_exclude $out;
+close $info_exclude;
 
+exit 0;