Adding upstream version 3.6.12.upstream/3.6.12upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 202 insertions, 0 deletions

diff --git a/src/lib/Gitolite/Conf/Sugar.pm b/src/lib/Gitolite/Conf/Sugar.pm
new file mode 100644
index 0000000..5c743d3
--- /dev/null
+++ b/src/lib/Gitolite/Conf/Sugar.pm
@@ -0,0 +1,202 @@
+# and now for something completely different...
+
+package SugarBox;
+
+sub run_sugar_script {
+    my ( $ss, $lref ) = @_;
+    do $ss if -r $ss;
+    $lref = sugar_script($lref);
+    return $lref;
+}
+
+# ----------------------------------------------------------------------
+
+package Gitolite::Conf::Sugar;
+
+# syntactic sugar for the conf file, including site-local macros
+# ----------------------------------------------------------------------
+
+@EXPORT = qw(
+  sugar
+);
+
+use Exporter 'import';
+
+use Gitolite::Rc;
+use Gitolite::Common;
+use Gitolite::Conf::Explode;
+
+use strict;
+use warnings;
+
+# ----------------------------------------------------------------------
+
+sub sugar {
+    # gets a filename, returns a listref
+
+    my @lines = ();
+    explode( shift, 'master', \@lines );
+
+    my $lines;
+    $lines = \@lines;
+
+    # run through the sugar stack one by one
+
+    # first, user supplied sugar:
+    if ( exists $rc{SYNTACTIC_SUGAR} ) {
+        if ( ref( $rc{SYNTACTIC_SUGAR} ) ne 'ARRAY' ) {
+            _warn "bad syntax for specifying sugar scripts; see docs";
+        } else {
+            for my $s ( @{ $rc{SYNTACTIC_SUGAR} } ) {
+
+                # perl-ism; apart from keeping the full path separate from the
+                # simple name, this also protects %rc from change by implicit
+                # aliasing, which would happen if you touched $s itself
+                my $sfp = _which( "syntactic-sugar/$s", 'r' );
+
+                _warn("skipped sugar script '$s'"), next if not -r $sfp;
+                $lines = SugarBox::run_sugar_script( $sfp, $lines );
+                $lines = [ grep /\S/, map { cleanup_conf_line($_) } @$lines ];
+            }
+        }
+    }
+
+    # then our stuff:
+
+    $lines = rw_cdm($lines);
+    $lines = option($lines);       # must come after rw_cdm
+    $lines = owner_desc($lines);
+    $lines = name_vref($lines);
+    $lines = role_names($lines);
+    $lines = skip_block($lines);
+
+    return $lines;
+}
+
+sub rw_cdm {
+    my $lines = shift;
+    my @ret;
+
+    # repo foo <...> RWC = ...
+    #   ->  option CREATE_IS_C = 1
+    # (and similarly DELETE_IS_D and MERGE_CHECK)
+    # but only once per repo of course
+
+    my %seen = ();
+    for my $line (@$lines) {
+        push @ret, $line;
+        if ( $line =~ /^repo / ) {
+            %seen = ();
+        } elsif ( $line =~ /^(-|C|R|RW\+?(?:C?D?|D?C?)M?) (.* )?= (.+)/ ) {
+            my $perms = $1;
+            push @ret, "option DELETE_IS_D = 1" if $perms =~ /D/     and not $seen{D}++;
+            push @ret, "option CREATE_IS_C = 1" if $perms =~ /RW.*C/ and not $seen{C}++;
+            push @ret, "option MERGE_CHECK = 1" if $perms =~ /M/     and not $seen{M}++;
+        }
+    }
+    return \@ret;
+}
+
+sub option {
+    my $lines = shift;
+    my @ret;
+
+    # option foo = bar
+    #   ->  config gitolite-options.foo = bar
+
+    for my $line (@$lines) {
+        $line =~ s/option mirror\.slaves/option mirror.copies/;
+        if ( $line =~ /^option (\S+) = (\S.*)/ ) {
+            push @ret, "config gitolite-options.$1 = $2";
+        } else {
+            push @ret, $line;
+        }
+    }
+    return \@ret;
+}
+
+sub owner_desc {
+    my $lines = shift;
+    my @ret;
+
+    # owner = "owner name"
+    #   ->  config gitweb.owner = owner name
+    # desc = "some long description"
+    #   ->  config gitweb.description = some long description
+    # category = "whatever..."
+    #   ->  config gitweb.category = whatever...
+
+    for my $line (@$lines) {
+        if ( $line =~ /^desc = (\S.*)/ ) {
+            push @ret, "config gitweb.description = $1";
+        } elsif ( $line =~ /^owner = (\S.*)/ ) {
+            push @ret, "config gitweb.owner = $1";
+        } elsif ( $line =~ /^category = (\S.*)/ ) {
+            push @ret, "config gitweb.category = $1";
+        } else {
+            push @ret, $line;
+        }
+    }
+    return \@ret;
+}
+
+sub name_vref {
+    my $lines = shift;
+    my @ret;
+
+    # <perm> NAME/foo = <user>
+    #   ->  <perm> VREF/NAME/foo = <user>
+
+    for my $line (@$lines) {
+        if ( $line =~ /^(-|R\S+) \S.* = \S.*/ ) {
+            $line =~ s( NAME/)( VREF/NAME/)g;
+        }
+        push @ret, $line;
+    }
+    return \@ret;
+}
+
+sub role_names {
+    my $lines = shift;
+    my @ret;
+
+    # <perm> [<ref>] = <user list containing CREATOR|READERS|WRITERS>
+    #   ->  same but with "@" prepended to rolenames
+
+    for my $line (@$lines) {
+        if ( $line =~ /^(-|C|R|RW\+?(?:C?D?|D?C?)M?) (.* )?= (.+)/ ) {
+            my ( $p, $r ) = ( $1, $2 );
+            my $u = '';
+            for ( split ' ', $3 ) {
+                $_ = "\@$_" if $_ eq 'CREATOR' or $rc{ROLES}{$_};
+                $u .= " $_";
+            }
+            $r ||= '';
+            # mind the spaces (or play safe and run cleanup_conf_line again)
+            push @ret, cleanup_conf_line("$p $r = $u");
+        } else {
+            push @ret, $line;
+        }
+    }
+    return \@ret;
+}
+
+sub skip_block {
+    my $lines = shift;
+
+    my @out  = ();
+    for (@$lines) {
+        my $skip = 0;
+        $skip = 1 if /^= *begin testconf$/;
+        $skip = 1 if /^= *begin template-data$/;
+        # add code for other types of blocks here as needed
+
+        next if $skip .. /^= *end$/;
+        push @out, $_;
+    }
+
+    return \@out;
+}
+
+1;
+