gitolite/Gitolite/Conf/Sugar.pm
Sitaram Chamarty 60e190215e very basic, usable, first cut done
- sausage making hidden
  - lots of important features missing
2012-03-24 10:30:37 +05:30

83 lines
2.4 KiB
Perl

package Gitolite::Conf::Sugar;
# syntactic sugar for the conf file, including site-local macros
# ----------------------------------------------------------------------
@EXPORT = qw(
macro_expand
cleanup_conf_line
);
use Exporter 'import';
use lib $ENV{GL_BINDIR};
use Gitolite::Common;
use Gitolite::Rc;
use strict;
use warnings;
# ----------------------------------------------------------------------
sub macro_expand {
# site-local macros, if any, then gitolite internal macros, to munge the
# input conf line if needed
my @lines = @_;
# TODO: user macros, how to allow the user to specify them?
# cheat, to keep *our* regexes simple :)
# XXX but this also kills the special '# BEGIN filename' and '# END
# filename' lines that explode() surrounds the actual data with when it
# called macro_expand(). Right now we don't need it, but...
@lines = grep /\S/, map { cleanup_conf_line($_) } @lines;
@lines = owner_desc(@lines);
return @lines;
}
sub cleanup_conf_line {
my $line = shift;
# kill comments, but take care of "#" inside *simple* strings
$line =~ s/^((".*?"|[^#"])*)#.*/$1/;
# normalise whitespace; keeps later regexes very simple
$line =~ s/=/ = /;
$line =~ s/\s+/ /g;
$line =~ s/^ //;
$line =~ s/ $//;
return $line;
}
sub owner_desc {
my @lines = @_;
my @ret;
for my $line (@lines) {
# reponame = "some description string"
# reponame "owner name" = "some description string"
if ( $line =~ /^(\S+)(?: "(.*?)")? = "(.*)"$/ ) {
my ( $repo, $owner, $desc ) = ( $1, $2, $3 );
# XXX these two checks should go into add_config
# _die "bad repo name '$repo'" unless $repo =~ $REPONAME_PATT;
# _die "$fragment attempting to set description for $repo"
# if check_fragment_repo_disallowed( $fragment, $repo );
push @ret, "config gitolite-options.repo-desc = $desc";
push @ret, "config gitolite-options.repo-owner = $owner" if $owner;
} elsif ( $line =~ /^desc = (\S.*)/ ) {
push @ret, "config gitolite-options.repo-desc = $1";
} elsif ( $line =~ /^owner = (\S.*)/ ) {
my ( $repo, $owner, $desc ) = ( $1, $2, $3 );
push @ret, "config gitolite-options.repo-owner = $1";
} else {
push @ret, $line;
}
}
return @ret;
}
1;