view release on metacpan or  search on metacpan

script/kgb-bot  view on Meta::CPAN

    return $polygen;
}

sub merge_conf_hash($$);

sub merge_conf_hash($$) {
    my ( $dst, $src ) = @_;

    while ( my ($k, $v) = each %$src ) {
        if ( ref($v) ) {
            if ( exists $dst->{$k} ) {
                die
                    "Error merging key '$k': source is a reference, but destination is scalar\n"
                    unless ref( $dst->{$k} );
                ref( $dst->{$k} ) eq ref($v)
                    or die
                    "Error merging key '$k': reference type mismatch\n";
                if ( ref($v) eq 'ARRAY' ) {
                    push @{ $dst->{$k} }, @$v;
                }
                elsif ( ref($v) eq 'HASH' ) {
                    merge_conf_hash( $dst->{$k}, $v );
                }
                else {
                    die "Error merging key '$k': unknown reference type\n";
                }
            }
            else {
                $dst->{$k} = $v;
            }
        }
        else {
            die
                "Error merging key '$k': source is scalar, but destination is not\n"
                if exists $dst->{$k} and ref( $dst->{$k} );
            $dst->{$k} = $v;
        }
    }
}

sub parse_conf_file($;$);
sub parse_conf_file($;$) {
    my $src = shift;
    my $met = shift // {};

    return {} if $met->{$src}++;

    my $conf = {};
    KGB->debug("Loading '$src.");
    if ( -d $src ) {
        -r _ or die "'$src' is not readable\n";
        -x _ or die "'$src' is not usable (missing execute permission)\n";
        for ( sort <$src/*.conf> ) {
            my $c = parse_conf_file($_);

            eval { merge_conf_hash( $conf, $c ); 1 } or die "Error loading $_: $@";
        }
    }
    elsif ( -e $src ) {
        die "$src is world-readable\n" if ( stat($src) )[2] & 04;

        $conf = YAML::LoadFile($src)
            or die "Error loading config from $src\n";
    }
    else {
        die "'$src' does not exist\n";
    }

    if ( exists $conf->{include} ) {
        my $inc = $conf->{include};
        my @inc;

        if (ref($inc)) {
            die "'include' should be scalar or list\n"
                unless ref($inc) eq 'ARRAY';

            push @inc, @$inc;
        }
        else {
            push @inc, $inc;
        }

        for my $f ( @inc ) {
            my $c = parse_conf_file( $f, $met );
            eval { merge_conf_hash( $conf, $c ); 1 } or die "Error loading $f: $@";
        }
    }

    return $conf;
}

sub read_conf ($) {
    my $file = shift;

    my $conf = {};
    $conf = parse_conf_file($file) if -e $file;

    die "Invalid or missing config key: soap"
        unless ( ref $conf->{soap}
        and ref $conf->{soap} eq "HASH" );
    die "Invalid or missing config key: repositories"
        unless ( ref $conf->{repositories}
        and ref $conf->{repositories} eq "HASH" );
    die "Invalid or missing config key: networks"
        unless ( ref $conf->{networks}
        and ref $conf->{networks} eq "HASH" );
    die "Invalid or missing config key: channels"
        unless ( ref $conf->{channels}
        and ref $conf->{channels} eq "ARRAY" );

    $conf->{soap}{service_name} ||= "KGB";
    $conf->{soap}{server_port}  ||= 5391;
    $conf->{soap}{server_addr}  ||= "127.0.0.1";

    if ( my $queue_limit = ( $conf->{queue_limit} //= 150 ) ) {
        $queue_limit =~ /^\d{1,10}$/
            or die
            "Invalid value for config key 'queue_limit' ($queue_limit)";
    }