alexandrie/alexandrie

164 lines
6.3 KiB
Perl
Executable File

#! /usr/bin/perl -w
use strict;
use warnings;
use POE qw(Component::IRC);
use List::MoreUtils qw(any);
use DBI;
use Config::Simple;
# CONFIGURATION FILE
my $alexandrieConf = new Config::Simple("/etc/alexandrie/alexandrie.conf") or die "Missing configuration file.";
print "Configuration file loaded.\n";
# PARSER
my $parser = $alexandrieConf->param("parser.path");
# DATABASE
my $dsn = $alexandrieConf->param("database.dsn");
my $db_user_name = $alexandrieConf->param("database.username");
my $db_password = $alexandrieConf->param("database.password");
my $dbh = $alexandrieConf->param("database.dbh");
# IRC
my $nickname = $alexandrieConf->param("irc.nickname");
my $ircname = $alexandrieConf->param("irc.name");
my $server = $alexandrieConf->param("irc.server");
my $username = $alexandrieConf->param("irc.username");
my @channels = ('#april', '#april-alexandrie');
#my @channels = ('#april-alexandrie');
# We create a new PoCo-IRC object
my $irc = POE::Component::IRC->spawn(
nick => $nickname,
ircname => $ircname,
username => $username,
server => $server,
) or die "Oh noooo! $!";
POE::Session->create(
package_states => [
main => [ qw(_default _start irc_001 irc_public) ],
],
heap => { irc => $irc },
);
$poe_kernel->run();
sub _start {
my $heap = $_[HEAP];
# retrieve our component's object from the heap where we stashed it
my $irc = $heap->{irc};
$irc->yield( register => 'all' );
$irc->yield( connect => { } );
return;
}
sub irc_001 {
my $sender = $_[SENDER];
# Since this is an irc_* event, we can get the component's object by
# accessing the heap of the sender. Then we register and connect to the
# specified server.
my $irc = $sender->get_heap();
print "Connected to ", $irc->server_name(), "\n";
# we join our channels
$irc->yield( join => $_ ) for @channels;
$irc->yield( privmsg => $_ => "Join us now and share the softwaaaare ♩ ♪ ♫ ♬ ♭" ) for @channels;
return;
}
sub irc_public {
my ($sender, $who, $where, $what) = @_[SENDER, ARG0 .. ARG2];
my $nick = ( split /!/, $who )[0];
my $channel = $where->[0];
#RP
if (my ($cite, $url, undef, $base_url, $comment) = $what =~ /!rp(c?).*?((https?:\/\/)?(\S+))\s*(.*)/) {
my $dbh = DBI->connect($dsn, $db_user_name, $db_password);
my $exists = $dbh->prepare ('SELECT id FROM presse WHERE url LIKE ?');
unless ($exists->execute ("%$base_url")) {
$irc->yield( privmsg => $channel => 'Opération impossible. #Fail ! Je préfère partir plutôt que d\'entrendre ça plutôt que d\'être sourd(e)');
die "Fatal: cannot RECONNECT ! : $!";
}
my @found = $exists->fetchrow_array();
$exists->finish;
if (@found) {
my $rp_inc= $dbh->prepare ('UPDATE presse SET note=note+1 WHERE id = ?');
$rp_inc->execute ($found['id']);
my $add_comment = $dbh->prepare ('INSERT INTO presse_comments SET commentaire=?, presse_id=?, auteur=?');
$add_comment->execute ($comment, $found['id'], "IRC($nick)")
unless ($comment eq "");
$irc->yield( privmsg => $channel => ($nick =~ /alxc/)?'Mais enfin roooo, je l\'ai déjà depuis super longtemps cette url. M\'enfin merci quand même Alix :*':'Merci, j\'avais déjà cet article en stock. Je plusse');
} else {
my $rp_insert = $dbh->prepare ('INSERT INTO presse SET url=?, provenance=?, cite=?, note=?, datec=NOW()');
my $note = (any {$nick =~ $_ } qr/echarp/, qr/gibus/, qr/oumph/, qr/theocrite/, qr/madix/, qr/liot/, qr/lonugem/)?3:0;
$rp_insert->execute ($url, "IRC($nick)", ($cite eq 'c'?1:0), $note);
my $last_insert_id = $dbh->last_insert_id (undef, undef, undef, 'presse');
my $add_comment = $dbh->prepare ('INSERT INTO presse_comments SET commentaire=?, presse_id=?, auteur=?');
$add_comment->execute ($comment, $last_insert_id, "IRC($nick)")
unless ($comment eq "");
$irc->yield( privmsg => $channel => ($nick =~ /alxc/)?'Merci Alix ! Je conserve ça précieusement !':"Merci bien $nick, cet article a été ajouté :)");
`$parser $last_insert_id`;
}
$dbh->disconnect();
}
# Help
$irc->yield( privmsg => $channel => 'Toute l\'aide est disponible ici : http://wiki.april.org/w/RP:alexandrie')
if ($what =~ /!help/ or $what =~ /!aide/);
# Easter eggs :
$irc->yield( privmsg => $channel => "<3")
if ($nick =~ /theo/ and $what =~ /alex.ndri.*aime/);
if ($what =~ /alex.ndri.*alex.ndra/) {
my @lyrics = (
'Voile sur les filles... barques sur le Nil.',
'Je suis dans ta vie... je suis dans tes bras.',
'Alexandrie où l\'amour danse avec la nuit.',
'J\'ai plus d\'appétit... qu\'un Barracuda.',
'Je boirais tout le nil si tu ne me reviens pas.',
'Ce soir j\'ai de la fièvre et toi tu meurs de froid.',
'Les sirènes du port d\'Alexandrie... chantent encore la même mélodie. Wooo woooo oooo',
'La lumière du phare d\'Alexandrie... fait naufrager... les papillons... de ma jeunesseuuuu... Ah!');
$irc->yield( privmsg => $channel => $lyrics[int rand $#lyrics]);
}
# Administration
my ($chan, $text);
if ($nick eq 'theocrite' and $what eq '!quit') {
$irc->yield( shutdown => 'Je préfère partir plutôt que d\'entrendre ça plutôt que d\'être sourd(e)' );
exit;
}
$irc->yield( part => $chan, ' '.$text )
if ($nick eq 'theocrite' and ($chan, $text) = $what =~ /^!part\s+(#\S+)\s*(.*)$/);
$irc->yield( join => $chan )
if ($nick eq 'theocrite' and ($chan) = $what =~ /^!join\s+(#\S+)$/);
$irc->yield( privmsg => $chan => $text)
if ($nick eq 'theocrite' and ($chan, $text) = $what =~ /^!msg (#\S+)\s+(.*)$/);
return;
}
# We registered for all events, this will produce some debug info.
sub _default {
my ($event, $args) = @_[ARG0 .. $#_];
my @output = ( "$event: " );
for my $arg (@$args) {
if ( ref $arg eq 'ARRAY' ) {
push( @output, '[' . join(', ', @$arg ) . ']' );
}
else {
push ( @output, "'$arg'" );
}
}
print join ' ', @output, "\n";
return 0;
}