view release on metacpan or  search on metacpan

script/kgb-bot  view on Meta::CPAN

            "). I only know about protocols ",
            join( ", ", keys %KGB::supported_protos ),
            ".\n"
        );
    }
    foreach ( keys %{ $conf->{networks} } ) {
        $conf->{networks}{$_}{nick}     ||= "KGB";
        $conf->{networks}{$_}{ircname}  ||= "KGB bot";
        $conf->{networks}{$_}{username} ||= "kgb";
        $conf->{networks}{$_}{use_ssl}  //= 1;
        $conf->{networks}{$_}{port}     ||= $conf->{networks}{$_}{use_ssl} ? 6697 : 6667;
        die "Missing server name in network $_\n"
            unless $conf->{networks}{$_}{server};
    }

    $conf->{broadcast_channels} = [];

    $_->{chanids} //= [] for values %{ $conf->{repositories} };

    my %chanidx;
    foreach ( @{ $conf->{channels} } ) {
        $_->{repositories} //= [];
        die "Missing channel name at channel\n" unless ( $_->{name} );
        die "Invalid network at channel " . $_->{name} . "\n"
            unless ( $_->{network} and $conf->{networks}{ $_->{network} } );
        $conf->{networks}{ $_->{network} }{channels}{$_->{name}} = $_->{secret};
        my $chanid = KGB->get_chanid( $_->{network}, $_->{name} );
        die "Invalid repos key at channel $chanid\n"
            unless $_->{broadcast}
            or ( ref $_->{repos} and ref $_->{repos} eq "ARRAY" );
        if ( $_->{broadcast} ) {
            push @{ $conf->{broadcast_channels} }, $chanid;
            KGB->out("Repository list ignored for broadcast channel $chanid\n")
                if @{ $_->{repositories} };
        }
        else {
            KGB->out("Channel $chanid doesn't listen on any repository\n")
                unless @{ $_->{repos} };
            foreach my $repo ( @{ $_->{repos} } ) {
                die "Invalid repository $repo at channel $chanid\n"
                    unless ( $conf->{repositories}{$repo} );
                push @{ $conf->{repositories}{$repo}{chanids} }, $chanid;
            }
        }
        $_->{chanid} = $chanid;
        $chanidx{$chanid} = $_;
    }
    $conf->{chanidx} = \%chanidx;

    $conf->{colors}             ||= {};
    $conf->{colors}{revision}   //= '';
    $conf->{colors}{path}       //= 'teal';
    $conf->{colors}{author}     //= 'purple';
    $conf->{colors}{branch}     //= 'brown';
    $conf->{colors}{module}     //= 'green';
    $conf->{colors}{web}        //= 'silver';
    $conf->{colors}{separator}  //= '';

    $conf->{colors}{addition}     //= 'green';
    $conf->{colors}{modification} //= 'teal';
    $conf->{colors}{deletion}     //= 'bold red';
    $conf->{colors}{replacement}  //= 'brown';

    $conf->{colors}{prop_change} //= 'underline';

    $conf->{colors}{success}     //= 'reverse green';
    $conf->{colors}{failure}     //= 'reverse red';

    $KGB::debug = $conf->{debug} if exists $conf->{debug};
    $conf->{pid_dir}
        = Cwd::realpath( $conf->{pid_dir} // '/var/run/kgb-bot' );

    if (    exists $conf->{webhook}
        and exists $conf->{webhook}{allowed_networks} )
    {
        $_ = Net::IP->new($_) for @{ $conf->{webhook}{allowed_networks} };
    }

    KGB->debug( JSON::XS->new->convert_blessed(1)->encode($conf) );
    return $conf;
}

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

    # Save globals
    $config_file = Cwd::realpath($file);
    $config      = $conf;

    return $conf;
}

sub reload_conf() {
    my $new_conf = eval { KGB::read_conf($config_file) };
    if ($@) {
        KGB->out("Error in configuration file: $@");
        return -1;
    }
    if (   $new_conf->{soap}{service_name} ne $config->{soap}{service_name}
        or $new_conf->{soap}{server_port} ne $config->{soap}{server_port}
        or $new_conf->{soap}{server_addr} ne $config->{soap}{server_addr} )
    {
        KGB->out("Cannot reload configuration file, restarting\n");
        return -2;    # need restart
    }

    $painter =
        App::KGB::Painter->new( { item_colors => $new_conf->{colors} } );

    KGB->out("Configuration file reloaded\n");
    $config = $new_conf;
    return 0;
}

sub out {
    shift;
    print $KGB::out localtime->strftime('%Y.%m.%d %H:%M:%S').': ', @_, ( $_[-1] =~ /\n$/s ) ? () : "\n";
}

sub debug {