#!/usr/bin/perl -w

# $Revision: 1.4 $
# $Id: cpanbot,v 1.4 2003/08/28 09:32:31 afoxson Exp $
#
# cpanbot - wrapper script for Bot::CPAN
# Copyright (C) 2003 Adam J. Foxson <afoxson@pobox.com>. All rights reserved.

# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.

use strict;
use Config::Auto;
use Getopt::Long;
use Bot::CPAN;

my $config = Config::Auto::parse();
my @channels = ref $config->{channels} ?
	@{$config->{channels}} : $config->{channels} || ();
my @servers = ref $config->{servers} ?
	@{$config->{servers}} : $config->{servers} || ();
my $port; # = $config->{port} || 6667;
my $nick = $config->{nick} || 'CPAN' . $$;
my @alt_nicks = ref $config->{alt_nicks} ?
	@{$config->{alt_nicks}} : $config->{alt_nicks} || ();
my $username = $config->{username};
my $name = $config->{name};
my @ignore_list = ref $config->{ignore_list} ?
	@{$config->{ignore_list}} : $config->{ignore_list} || ();
my $reload_indices_interval = $config->{reload_indices_interval} || 300;
my $inform_channel_of_new_uploads =
	$config->{inform_channel_of_new_uploads} || 60;
my $debug = $config->{debug} || 0;
my $search_max_results = $config->{search_max_results} || 20;
my $adminhost = $config->{adminhost} || qr/\b\B/;
my $news_server = $config->{news_server} || 'nntp.perl.org';
my $group = $config->{group} || 'perl.cpan.testers';
my @policy = ref $config->{policy} ?
	@{$config->{policy}} : $config->{policy} || ();

&get_opts();
&check_mandatories(channels => \@channels, servers => \@servers);
&decommafy(\@channels, \@servers, \@alt_nicks, \@ignore_list);
&start_bot(&normalize_policy());

sub get_opts {
	GetOptions(
		"channels=s" => \@channels,
		"servers=s" => \@servers,
		"port=i" => \$port,
		"nick=s" => \$nick,
		"alt_nicks=s" => \@alt_nicks,
		"username=s" => \$username,
		"name=s" => \$name,
		"ignore_list=s" => \@ignore_list,
		"reload_indices_interval=i" => \$reload_indices_interval,
		"inform_channel_of_new_uploads=i" => \$inform_channel_of_new_uploads,
		"debug=i" => \$debug,
		"search_max_results=i" => \$search_max_results,
		"adminhost=s" => \$adminhost,
		"news_server=s" => \$news_server,
		"group=s" => \$group,
		"policy=s" => \@policy,
	);
}

sub check_mandatories {
	while (my ($name, $data) = splice @_, 0, 2) {
		die "Missing option: $name\n" if scalar @{$data} == 0;
	}
}

sub decommafy {
	for my $multi (@_) {
		my @hold;
		my %kill;
		my @final;
		for my $str (@{$multi}) {
			my @multi = split /,/, $str;
			if (scalar @multi > 1) {
				push @hold, @multi;
				$kill{$str}++;
			}
		}
		for my $held (@hold) {
			push @{$multi}, $held;
		}
		for my $str (@{$multi}) {
			push @final, $str if not exists $kill{$str};
		}
		@{$multi} = @final;
	}
}

sub normalize_policy {
	&bad_policy() unless scalar @policy % 6 == 0;

	my %slr;
	while (my ($chan, $a_or_d, $regex) = splice @policy, 0, 3) {
		if ($chan !~ /^#/ or $a_or_d !~ /^allow|deny$/ or $regex !~ /^qr/) {
			&bad_policy();
		}
		push @{$slr{$chan}}, $a_or_d, eval($regex);
	}

	my %policy;
	for my $chan (sort keys %slr) {
		$policy{$chan} = {@{$slr{$chan}}};
	}
	return \%policy;
}

sub bad_policy {
	die "Option 'policy' must be in the form of:\n\n" .
		"policy #channel allow qr//\n" .
		"policy #channel deny qr//\n";
}

sub start_bot {
	my $policy = shift;
	my $bot = Bot::CPAN->new(
		channels => \@channels,
		servers => \@servers,
		port => $port,
		nick => $nick,
		alt_nicks => \@alt_nicks,
		username => $username,
		name => $name,
		ignore_list => \@ignore_list,
		news_server => $news_server,
		group => $group,
		reload_indices_interval => $reload_indices_interval,
		inform_channel_of_new_uploads => $inform_channel_of_new_uploads,
		debug => $debug,
		search_max_results => $search_max_results,
		policy => $policy,
		adminhost => eval($adminhost),
	);

	$bot->run();
}

__END__

=pod

=head1 NAME

cpanbot - wrapper script for Bot::CPAN

=head1 SYNOPSIS

 # start the bot, using a config file
 $ cpanbot &
 # same as above, plus log all output to /tmp/cpanbot
 $ cpanbot >>/tmp/cpanbot 2>&1 &
 # start the bot, using a config file, adding two servers
 $ cpanbot --servers=grou.ch,binky.rhizomatic.net &
 # same as above, plus log all output to /tmp/cpanbot
 $ cpanbot --servers=grou.ch,binky.rhizomatic.net >>/tmp/cpanbot 2>&1 &

=head1 DESCRIPTION

cpanbot is a wrapper around Bot::CPAN that takes a configuration file and
optional command-line arguments.

The config file is expected to reside at one of the following locations:

cpanbotconfig
~/cpanbotconfig
/etc/cpanbotconfig
cpanbot.config
~/cpanbot.config
/etc/cpanbot.config
cpanbotrc
~/cpanbotrc
/etc/cpanbotrc
.cpanbotrc
~/.cpanbotrc
/etc/.cpanbotrc

=head1 VALID OPTIONS

Single value options: port, nick, username, name, reload_indices_interval, inform_channel_of_new_uploads, debug, search_max_results, adminhost, news_server, group

Multiple value options: channels, servers, alt_nicks, ignore_list

=head1 EXAMPLE CONFIG

 channels #cpan
 channels #poe
 servers irc.perl.org
 servers binky.rhizomatic.net
 servers london.rhizomatic.net
 servers bullfrog.rhizomatic.net
 servers token.rhizomatic.net
 port 6667
 nick cpantest
 alt_nicks cpantest2
 alt_nicks cpantest3
 username cpantest
 name cpantest
 ignore_list purl
 ignore_list shorten
 reload_indices_interval 300
 inform_channel_of_new_uploads 60
 debug 0
 search_max_results 20
 adminhost qr/Fox!~Snak\@12-226-101-175\.client\.attbi\.com/
 news_server nntp.perl.org
 group perl.cpan.testers
 policy #poe allow qr/^POE-/i
 policy #poe deny qr/.+/

=head1 COPYRIGHT

  Copyright (c) 2003 Adam J. Foxson. All rights reserved.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
details.

=head1 SEE ALSO

=over 4

=item * L<perl>

=item * L<Bot::CPAN>

=item * L<Config::Auto>

=item * L<Getopt::Long>

=back

=head1 AUTHOR

Adam J. Foxson E<lt>F<afoxson@pobox.com>E<gt>

=cut
