summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2009-08-04 21:30:35 +0200
committerYorhel <git@yorhel.nl>2009-08-04 21:41:37 +0200
commitbbd7164d6d7ece18243b969d1db76ccf09804484 (patch)
treef897449a0b197893a4206c467d79dd67a2713682 /lib
parentcc450b80beb72f91dbf56ab5e23f57eef87323af (diff)
Started on Multi::IRC rewrite
Most of the functionality of the old IRC bot should be present again, with notifications and the !vn command being the only exceptions. I'll reimplement those later. The configuration has changed a little: - 'user' variable renamed to 'nick' - 'channel' renamed to 'channels' (it's an arrayref, after all) - the 'masters' variable now uses IRC masks rather than nicks This new version also has three user levels rather than two: regular users, OPs in the first channel, and 'masters'. This way #vndb OPs can get control over some useful functions as well. The 'master' functions are far too powerful and as such should only be used by the person operating the bot.
Diffstat (limited to 'lib')
-rw-r--r--lib/Multi/IRC.pm500
1 files changed, 246 insertions, 254 deletions
diff --git a/lib/Multi/IRC.pm b/lib/Multi/IRC.pm
index 02be04fb..49a40874 100644
--- a/lib/Multi/IRC.pm
+++ b/lib/Multi/IRC.pm
@@ -15,41 +15,51 @@ use POE qw|
|;
use POE::Component::IRC::Common ':ALL';
use URI::Escape 'uri_escape_utf8';
-use Net::HTTP;
use constant {
- ARG => ARG0,
+ USER => ARG0,
DEST => ARG1,
- NICK => ARG2
+ ARG => ARG2,
+ MASK => ARG3,
};
+my $irc;
-sub spawn {
- return if $Multi::DAEMONIZE != 0; # we don't provide any commands, after all
+sub spawn {
my $p = shift;
- my $irc = POE::Component::IRC::State->spawn(
+ $irc = POE::Component::IRC::State->spawn(
alias => 'circ',
NoDNS => 1,
);
POE::Session->create(
package_states => [
$p => [qw|
- _start irc_001 irc_public irc_ctcp_action irc_msg irccmd vndbid ircnotify shutdown
- cmd_info cmd_vndb cmd_list cmd_vn cmd_uptime cmd_notifications cmd_me cmd_say cmd_cmd cmd_eval
+ _start shutdown irc_001 irc_public irc_ctcp_action irc_msg command reply
+ cmd_info cmd_list cmd_uptime cmd_uptime cmd_say cmd_me
+ cmd_eval cmd_die cmd_post vndbid formatid
|],
],
- heap => { irc => $irc,
- o => {
- user => 'Multi_test'.$$,
- server => 'irc.synirc.net',
- ircname => 'VNDB.org Multi',
- channel => [ '#vndb' ],
- @_
- },
+ heap => {
+ nick => 'Multi_test'.$$,
+ server => 'irc.synirc.net',
+ ircname => 'VNDB.org Multi',
+ channels => [ '#vndb' ],
+ masters => [ 'yorhel!*@*' ],
+ @_,
log => {},
privpers => {},
notify => [],
+ commands => {
+ info => 0, # argument = authentication level.
+ list => 0, # 0: everyone,
+ uptime => 0, # 1: only OPs in the first channel listed in @channels
+ say => 1, # 2: only users matching the mask in @masters
+ me => 1,
+ eval => 2,
+ die => 2,
+ post => 2,
+ },
}
);
}
@@ -57,243 +67,304 @@ sub spawn {
sub _start {
$_[KERNEL]->alias_set('irc');
- $_[KERNEL]->call(core => register => qr/^ircnotify ([vrptg][0-9]+(?:\.[0-9]+)?)$/, 'ircnotify');
- $_[HEAP]{irc}->plugin_add(
+ $irc->plugin_add(
Logger => POE::Component::IRC::Plugin::Logger->new(
Path => $VNDB::M{log_dir},
Private => 0,
Public => 1,
));
- $_[HEAP]{irc}->plugin_add(
+ $irc->plugin_add(
Connector => POE::Component::IRC::Plugin::Connector->new()
);
- $_[HEAP]{irc}->plugin_add(
+ $irc->plugin_add(
CTCP => POE::Component::IRC::Plugin::CTCP->new(
- version => $_[HEAP]{o}{ircname}.' v'.$VNDB::S{version},
- userinfo => $_[HEAP]{o}{ircname},
+ version => $_[HEAP]{ircname}.' v'.$VNDB::S{version},
+ userinfo => $_[HEAP]{ircname},
));
- if($_[HEAP]{o}{pass}) {
+ if($_[HEAP]{pass}) {
require POE::Component::IRC::Plugin::NickServID;
- $_[HEAP]{irc}->plugin_add(
+ $irc->plugin_add(
NickServID => POE::Component::IRC::Plugin::NickServID->new(
- Password => $_[HEAP]{o}{pass}
- ))
+ Password => $_[HEAP]{pass}
+ ))
}
- if($_[HEAP]{o}{console}) {
+ if($_[HEAP]{console}) {
require POE::Component::IRC::Plugin::Console;
- $_[HEAP]{irc}->plugin_add(
+ $irc->plugin_add(
Console => POE::Component::IRC::Plugin::Console->new(
bindport => 3030,
- password => $_[HEAP]{o}{console}
- ))
+ password => $_[HEAP]{console}
+ ))
}
- $_[KERNEL]->post(circ => register => 'all');
- $_[KERNEL]->post(circ => connect => {
- Nick => $_[HEAP]{o}{user},
+ $irc->yield(register => 'all');
+ $irc->yield(connect => {
+ Nick => $_[HEAP]{nick},
Username => 'u1',
- Ircname => $_[HEAP]{o}{ircname},
- Server => $_[HEAP]{o}{server},
+ Ircname => $_[HEAP]{ircname},
+ Server => $_[HEAP]{server},
});
- # notifications in the main channel enabled by default
- push @{$_[HEAP]{notify}}, $_[HEAP]{o}{channel}[0];
+ $_[KERNEL]->sig(shutdown => 'shutdown');
+}
- $_[KERNEL]->sig('shutdown' => 'shutdown');
+
+sub shutdown {
+ $irc->yield(shutdown => $_[ARG1]);
+ $_[KERNEL]->alias_remove('irc');
}
-sub irc_001 {
- $_[KERNEL]->post(circ => join => $_) for (@{$_[HEAP]{o}{channel}});
- $_[KERNEL]->call(core => log => 2, 'Connected to IRC!');
+sub irc_001 {
+ $irc->yield(join => $_) for (@{$_[HEAP]{channels}});
+ $_[KERNEL]->call(core => log => 'Connected to IRC');
}
-sub irc_public {
- if($_[ARG2] =~ /^!/) {
- (my $cmd = $_[ARG2]) =~ s/^!//;
- my $nick = (split /!/, $_[ARG0])[0];
- $_[KERNEL]->call(irc => irccmd => $_[ARG1][0], $cmd, $nick);
- } else {
- $_[KERNEL]->call(irc => vndbid => $_[ARG1][0], $_[ARG2]);
- }
+sub irc_public { # mask, dest, msg
+ return if $_[ARG2] =~ /^\s*!/ && $_[KERNEL]->call($_[SESSION] => command => @_[ARG0..$#_]);
+ $_[KERNEL]->call($_[SESSION] => vndbid => $_[ARG1], $_[ARG2]);
}
-sub irc_ctcp_action {
- $_[KERNEL]->call(irc => vndbid => $_[ARG1][0], $_[ARG2]);
+sub irc_ctcp_action { # mask, dest, msg
+ $_[KERNEL]->call($_[SESSION] => vndbid => $_[ARG1], $_[ARG2]);
}
-sub irc_msg {
- my $nick = ( split /!/, $_[ARG0] )[0];
- $_[ARG2] =~ s/^!//;
- if(!$_[KERNEL]->call(irc => irccmd => $nick => $_[ARG2])) {
- $_[HEAP]{privpers}{$_} < time-3600 and delete $_[HEAP]{privpers}{$_}
- for (keys %{$_[HEAP]{privpers}});
- $_[KERNEL]->post(circ => privmsg => $nick => 'I am not human, join #vndb or PM Yorhel if you need something.')
- if !$_[HEAP]{privpers}{$nick};
- $_[HEAP]{privpers}{$nick} ||= time;
- }
+sub irc_msg { # mask, dest, msg
+ return if $_[KERNEL]->call($_[SESSION] => command => $_[ARG0], [scalar parse_user($_[ARG0])], $_[ARG2]);
+
+ my $usr = parse_user($_[ARG0]);
+ return if ($_[HEAP]{privpers}{$usr}||0) > time-300;
+ $irc->yield(notice => $usr, 'I am not human, join #vndb or PM Yorhel if you need something.');
+ $_[HEAP]{privpers}{$usr} = time;
}
-sub irccmd { # dest, cmd, [nick]
- my($dest, $cmd, $nick) = @_[ARG0..$#_];
- $nick ||= $_[ARG0];
+sub command { # mask, dest, msg
+ my($mask, $dest, $msg) = @_[ARG0..$#_];
- return 0 if $cmd !~ /^([a-z0-9A-Z_]+)(?: (.+))?$/;
- my($f, $a) = (lc $1, $2||'');
+ my $usr = parse_user($mask);
+ $msg =~ s/\s*!//;
+ return 0 if $msg !~ /^([a-z]+)(?:\s+(.+))?$/;
+ my($cmd, $arg) = ($1, $2);
+ return 0 if !exists $_[HEAP]{commands}{$cmd};
- # check for a cmd_* function and call it (some scary magic, see perlmod)
- my $sub;
- {
- no strict;
- $sub = ${__PACKAGE__.'::'}{'cmd_'.$f};
- }
- return 0 if !defined $sub;
- local *SUB = $sub;
- return 0 if !defined *SUB{CODE};
- $_[KERNEL]->yield('cmd_'.$f, $a, $dest, $nick);
- return 1;
+ return $_[KERNEL]->yield(reply => $dest,
+ $dest eq $_[HEAP]{channels}[0] ? 'Only OPs can do that!' : "Only $_[HEAP]{channel}[0] OPs can do that!", $usr) || 1
+ if $_[HEAP]{commands}{$cmd} == 1 && !$irc->is_channel_operator($_[HEAP]{channels}[0], $usr);
+ return $_[KERNEL]->yield(reply => $dest, 'You are not my master!', $usr) || 1
+ if $_[HEAP]{commands}{$cmd} == 2 && !grep matches_mask($_, $mask), @{$_[HEAP]{masters}};
+
+ return $_[KERNEL]->yield('cmd_'.$cmd, $usr, $dest, $arg, $mask) || 1;
+}
+
+
+# convenience function
+sub reply { # target, msg [, mask/user]
+ my $usr = $_[ARG0][0] =~ /^#/ && parse_user($_[ARG2]);
+ $irc->yield($_[ARG0][0] =~ /^#/ ? 'privmsg' : 'notice', $_[ARG0], ($usr ? "$usr, " : '').$_[ARG1]);
}
-sub vndbid { # dest, msg, force
- my $m = $_[ARG1];
- $_[HEAP]{log}{$_} < time-60 and delete $_[HEAP]{log}{$_}
- for (keys %{$_[HEAP]{log}});
- # Four possible options:
- # 1. [tvprug]+ -> item/user/thread/tag (nf)
- # 2. [vprt]+.+ -> revision/reply (ef)
- # 3. d+ -> documentation page (nf)
- # 4. d+.+ -> documentation page # section (sf)
+#
+# I R C C O M M A N D S
+#
+
+
+sub cmd_info {
+ $_[KERNEL]->yield(reply => $_[DEST],
+ 'Hi! I am HMX-12 Multi '.$VNDB::S{version}.', the IRC bot of '.$VNDB::S{url}.'/, written by the great Yorhel!');
+}
+
+
+sub cmd_list {
+ $_[KERNEL]->yield(reply => $_[DEST],
+ $_[DEST][0] =~ /^#/ ? 'This is not a warez channel!' : 'I am not a warez bot!', $_[USER]);
+}
+
- # nf (normal format): x+ : x, id, title
- # sf (sub format): x+.+ : x, id, subid, title, action2, title2
- # ef (extended format): x+.+ : x, id, subid, action, title, action2, title2
- my $nf = BOLD.RED.'['.NORMAL.BOLD.'%s%d' .RED.']' .NORMAL.' %s ' .RED.'@'.NORMAL.LIGHT_GREY.' '.$VNDB::S{url}.'/%1$s%2$d'.NORMAL;
- my $sf = BOLD.RED.'['.NORMAL.BOLD.'%s%d.%d'.RED.']' .NORMAL.' %s '.RED.'%s'.NORMAL.' %s '.RED.'@'.NORMAL.LIGHT_GREY.' '.$VNDB::S{url}.'/%1$s%2$d.%3$d'.NORMAL;
- my $ef = BOLD.RED.'['.NORMAL.BOLD.'%s%d.%d'.RED.']'.NORMAL.RED.' %s'.NORMAL.' %s '.RED.'%s'.NORMAL.' %s '.RED.'@'.NORMAL.LIGHT_GREY.' '.$VNDB::S{url}.'/%1$s%2$d.%3$d'.NORMAL;
+sub cmd_uptime {
+ my $age = sub {
+ return '...down!?' if !$_[0];
+ my $d = int $_[0] / 86400;
+ $_[0] %= 86400;
+ my $h = int $_[0] / 3600;
+ $_[0] %= 3600;
+ my $m = int $_[0] / 60;
+ $_[0] %= 60;
+ return sprintf '%s%02d:%02d:%02d', $d ? $d.' day'.($d>1?'s':'').', ' : '', $h, $m, int $_[0];
+ };
+
+ open my $R, '<', '/proc/uptime';
+ my $server = <$R> =~ /^\s*([0-9]+)/ ? $1 : 0;
+ close $R;
+ my $multi = time - $^T;
+
+ $_[KERNEL]->yield(reply => $_[DEST], sprintf 'Server uptime: %s -- mine: %s', $age->($server), $age->($multi));
+}
+
+
+sub cmd_say {
+ my $chan = $_[ARG] =~ s/^(#[a-zA-Z0-9-_.]+) // ? $1 : $_[DEST];
+ $irc->yield(privmsg => $chan, $_[ARG]);
+}
+
+
+sub cmd_me {
+ my $chan = $_[ARG] =~ s/^(#[a-zA-Z0-9-_.]+) // ? $1 : $_[DEST];
+ $irc->yield(ctcp => $chan, 'ACTION '.$_[ARG]);
+}
+
+
+sub cmd_eval {
+ $_[KERNEL]->yield(reply => $_[DEST], 'eval: '.$_)
+ for (split /\r?\n/, eval($_[ARG])||$@);
+}
+
+
+sub cmd_die {
+ $irc->yield(ctcp => $_[DEST] => 'ACTION dies');
+ $_[KERNEL]->signal(core => shutdown => "Killed on IRC by $_[USER]");
+}
+
+
+sub cmd_post {
+ $_[KERNEL]->yield(reply => $_[DEST], $_[KERNEL]->post(split /\s+/, $_[ARG])
+ ? 'Sent your message to the post office, it will be processed shortly!'
+ : "Oh no! The post office wouldn't accept your message! Wrong destination address?", $_[USER]);
+}
+
+
+
+
+#
+# D B I T E M L I N K S
+#
+
+
+sub vndbid { # dest, msg
+ my($dest, $msg) = @_[ARG0, ARG1];
+
+ $_[HEAP]{log}{$_} < time-60 and delete $_[HEAP]{log}{$_}
+ for (keys %{$_[HEAP]{log}});
- # get a list of possible IDs (a la sub summary in defs.pl)
my @id; # [ type, id, ref ]
- for (split /[, ]/, $m) {
+ for (split /[, ]/, $msg) {
next if length > 15 or m{[a-z]{3,6}://}i; # weed out URLs and too long things
- push @id, /^(?:.*[^\w]|)([dvprt])([1-9][0-9]*)\.([1-9][0-9]*)(?:[^\w].*|)$/ ? [ $1, $2, $3 ] # matches 2 and 4
- : /^(?:.*[^\w]|)([dvprtug])([1-9][0-9]*)(?:[^\w].*|)$/ ? [ $1, $2, 0 ] : (); # matches 1 and 3
+ push @id, /^(?:.*[^\w]|)([dvprt])([1-9][0-9]*)\.([1-9][0-9]*)(?:[^\w].*|)$/ ? [ $1, $2, $3 ] # x+.+
+ : /^(?:.*[^\w]|)([dvprtug])([1-9][0-9]*)(?:[^\w].*|)$/ ? [ $1, $2, 0 ] : (); # x+
}
- # loop through the matched IDs and search the database
for (@id) {
- my($t, $id, $rev) = (@$_);
+ my($t, $id, $rev) = @$_;
- next if $_[HEAP]{log}{$t.$id.'.'.$rev} && !$_[ARG2];
+ next if $_[HEAP]{log}{$t.$id.'.'.$rev};
$_[HEAP]{log}{$t.$id.'.'.$rev} = time;
- # option 1: item/user/thread/tag
- if($t =~ /[vprtug]/ && !$rev) {
- my $s = $Multi::SQL->prepare(
- $t eq 'v' ? 'SELECT vr.title FROM vn_rev vr JOIN vn v ON v.latest = vr.id WHERE v.id = ?' :
- $t eq 'u' ? 'SELECT u.username AS title FROM users u WHERE u.id = ?' :
- $t eq 'p' ? 'SELECT pr.name AS title FROM producers_rev pr JOIN producers p ON p.latest = pr.id WHERE p.id = ?' :
- $t eq 't' ? 'SELECT title FROM threads WHERE id = ?' :
- $t eq 'g' ? 'SELECT name AS title FROM tags WHERE id = ?' :
- 'SELECT rr.title FROM releases_rev rr JOIN releases r ON r.latest = rr.id WHERE r.id = ?'
- );
- $s->execute($id);
- my $r = $s->fetchrow_hashref;
- $s->finish;
- next if !$r || ref($r) ne 'HASH';
- $_[KERNEL]->post(circ => privmsg => $_[ARG0], sprintf $nf,
- $t, $id, $r->{title});
-
- # option 2: revision/reply
- } elsif($t =~ /[vprt]/) {
- my $s = $Multi::SQL->prepare(
- $t eq 'v' ? 'SELECT vr.title, u.username FROM changes c JOIN vn_rev vr ON c.id = vr.id JOIN users u ON u.id = c.requester WHERE vr.vid = ? AND c.rev = ?' :
- $t eq 'r' ? 'SELECT rr.title, u.username FROM changes c JOIN releases_rev rr ON c.id = rr.id JOIN users u ON u.id = c.requester WHERE rr.rid = ? AND c.rev = ?' :
- $t eq 'p' ? 'SELECT pr.name, u.username FROM changes c JOIN producers_rev pr ON c.id = pr.id JOIN users u ON u.id = c.requester WHERE pr.pid = ? AND c.rev = ?' :
- 'SELECT t.title, u.username FROM threads t JOIN threads_posts tp ON tp.tid = t.id JOIN users u ON u.id = tp.uid WHERE t.id = ? AND tp.num = ?'
- );
- $s->execute($id, $rev);
- my $r = $s->fetchrow_arrayref;
- next if !$r || ref($r) ne 'ARRAY';
- $_[KERNEL]->post(circ => privmsg => $_[ARG0], sprintf $ef, $t, $id, $rev,
- $rev == 1 ? 'New '.($t eq 'v' ? 'visual novel' : $t eq 'p' ? 'producer' : $t eq 'r' ? 'release': 'thread')
- : ($t eq 't' ? 'Reply to' : 'Edit of'), $r->[0], 'By', $r->[1]
- );
-
- # option 3: documentation page
- } elsif($t eq 'd') {
- my $f = sprintf '/www/vndb/data/docs/%d', $id;
+ # plain vn/user/producer/thread/tag/release
+ $_[KERNEL]->post(pg => query => 'SELECT ?::text AS type, ?::integer AS id, '.(
+ $t eq 'v' ? 'vr.title FROM vn_rev vr JOIN vn v ON v.latest = vr.id WHERE v.id = ?' :
+ $t eq 'u' ? 'u.username AS title FROM users u WHERE u.id = ?' :
+ $t eq 'p' ? 'pr.name AS title FROM producers_rev pr JOIN producers p ON p.latest = pr.id WHERE p.id = ?' :
+ $t eq 't' ? 'title FROM threads WHERE id = ?' :
+ $t eq 'g' ? 'name AS title FROM tags WHERE id = ?' :
+ 'rr.title FROM releases_rev rr JOIN releases r ON r.latest = rr.id WHERE r.id = ?'),
+ [ $t, $id, $id ], 'formatid', $dest
+ ) if !$rev && $t =~ /[vprtug]/;
+
+ # edit/insert of vn/release/producer or discussion board post
+ $_[KERNEL]->post(pg => query => 'SELECT ?::text AS type, ?::integer AS id, ?::integer AS rev, '.(
+ $t eq 'v' ? 'vr.title, u.username FROM changes c JOIN vn_rev vr ON c.id = vr.id JOIN users u ON u.id = c.requester WHERE vr.vid = ? AND c.rev = ?' :
+ $t eq 'r' ? 'rr.title, u.username FROM changes c JOIN releases_rev rr ON c.id = rr.id JOIN users u ON u.id = c.requester WHERE rr.rid = ? AND c.rev = ?' :
+ $t eq 'p' ? 'pr.name AS title, u.username FROM changes c JOIN producers_rev pr ON c.id = pr.id JOIN users u ON u.id = c.requester WHERE pr.pid = ? AND c.rev = ?' :
+ 't.title, u.username FROM threads t JOIN threads_posts tp ON tp.tid = t.id JOIN users u ON u.id = tp.uid WHERE t.id = ? AND tp.num = ?'),
+ [ $t, $id, $rev, $id, $rev], 'formatid', $dest
+ ) if $rev && $t =~ /[vprt]/;
+
+ # documentation page (need to parse the doc pages manually here)
+ if($t eq 'd') {
+ my $f = sprintf $VNDB::ROOT.'/data/docs/%d', $id;
+ my($title, $sec, $sub) = (undef, 0);
open my $F, '<', $f or next;
- (my $title = <$F>) =~ s/^:TITLE://;
- chomp($title);
-
- if(!$rev) {
- $_[KERNEL]->post(circ => privmsg => $_[ARG0], sprintf $nf,
- 'd', $id, $title);
- next;
- }
-
- # option 4: documentation page # section
- my($sec, $sub);
while(<$F>) {
- if(/^:SUB:/ && ++$sec == $rev) {
- chomp;
- ($sub = $_) =~ s/^:SUB://;
- last;
- }
+ chomp;
+ $title = $1 if /^:TITLE:(.+)$/;
+ $sub = $1 if $rev && /^:SUB:(.+)$/ && ++$sec == $rev;
}
- next if !$sub;
- $_[KERNEL]->post(circ => privmsg => $_[ARG0], sprintf $sf,
- 'd', $id, $rev, $title, '->', $sub);
+ close $F;
+ next if $rev && !$sub;
+ $_[KERNEL]->yield(formatid => 1, [{type => 'd', id => $id, title => $title, rev => $rev, section => $sub}], $dest);
}
}
}
-sub ircnotify { # command, VNDBID
- $_[KERNEL]->yield(vndbid => $_ => $_[ARG1] => 1) for (@{$_[HEAP]{notify}});
- $_[KERNEL]->post(core => finish => $_[ARG0]);
-}
+# formats and posts database items listed in @res, where each item is a hashref with:
+# type database item in [dvprtug]
+# id database id
+# title main name or title of the DB entry
+# rev (optional) revision, post number or section number
+# username (optional) relevant username
+# section (optional, for d+.+) section title
+sub formatid {
+ my($num, $res, $dest) = @_[ARG0..$#_];
+
+ # only the types for which creation/edit announcements matter
+ my %types = (
+ v => 'visual novel',
+ p => 'producer',
+ r => 'release',
+ g => 'tag',
+ t => 'thread',
+ );
+ for (@$res) {
+ my $id = $_->{type}.$_->{id} . ($_->{rev} ? '.'.$_->{rev} : '');
-sub shutdown {
- $_[KERNEL]->post(circ => shutdown => 'Byebye!');
-}
+ # (always) [x+.+]
+ my @msg = (
+ BOLD.RED.'['.NORMAL.BOLD.$id.RED.']'.NORMAL
+ );
+ # (only if username key is present) Edit of / New item / reply to / whatever
+ push @msg, RED.(
+ ($_->{rev}||1) == 1 ? 'New '.$types{$_->{type}} :
+ $_->{type} eq 't' ? 'Reply to' : 'Edit of'
+ ).NORMAL if $_->{username};
+ # (always) main title
+ push @msg, $_->{title};
-# cmd_* commands: $arg, $dest, $nick
+ # (only if username key is present) By [username]
+ push @msg, RED.'By'.NORMAL.' '.$_->{username} if $_->{username};
-sub cmd_info {
- $_[KERNEL]->post(circ => privmsg => $_[DEST],
- 'Hello, I am HMX-12 Multi v'.$VNDB::S{version}.' made by the great Yorhel!');
-}
+ # (for d+.+) -> section title
+ push @msg, RED.'->'.NORMAL.' '.$_->{section} if $_->{section};
+ # (always) @ URL
+ push @msg, RED.'@ '.NORMAL.LIGHT_GREY.$VNDB::S{url}.'/'.$id.NORMAL;
-sub cmd_vndb {
- $_[KERNEL]->post(circ => privmsg => $_[DEST],
- 'VNDB ~ The Visual Novel Database ~ http://vndb.org/');
+ # now post it
+ $_[KERNEL]->yield(reply => $dest, join ' ', @msg);
+ }
}
-sub cmd_list {
- return if $_[DEST] ne $_[HEAP]{o}{channel}[0];
- $_[KERNEL]->post(circ => privmsg => $_[DEST],
- $_[NICK].', this is not a warez channel!');
-}
+1;
+
+
+__END__
sub cmd_vn { # $arg = search string
$_[ARG] =~ s/%//g;
return $_[KERNEL]->post(circ => privmsg => $_[DEST], 'You forgot the search query, idiot~~!.') if !$_[ARG];
-
+
my $q = $Multi::SQL->prepare(q|
SELECT v.id
FROM vn v
@@ -322,38 +393,6 @@ sub cmd_vn { # $arg = search string
}
-sub cmd_uptime {
- my $age = sub {
- return '...down!?' if !$_[0];
- my $d = int $_[0] / 86400;
- $_[0] %= 86400;
- my $h = int $_[0] / 3600;
- $_[0] %= 3600;
- my $m = int $_[0] / 60;
- $_[0] %= 60;
- return sprintf '%s%02d:%02d:%02d', $d ? $d.' day'.($d>1?'s':'').', ' : '', $h, $m, int $_[0];
- };
-
- open my $R, '<', '/proc/uptime';
- my $server = <$R> =~ /^\s*([0-9]+)/ ? $1 : 0;
- close $R;
-
- my $multi = time - $^T;
-
- my $http=0;
- # this should actually be done asynchronously... but I don't expect it to timeout
- if(my $req = Net::HTTP->new(Host => 'localhost', Timeout => 1)) {
- $req->write_request(GET => '/server-status?auto');
- my $d;
- $req->read_entity_body($d, 1024) if $req->read_response_headers;
- $http = $1 if $d =~ /Uptime:\s*([0-9]+)/i;
- }
-
- $_[KERNEL]->post(circ => privmsg => $_[DEST], $_) for (split /\n/, sprintf
- "Uptimes:\n Server: %s\n Multi: %s\n HTTP: %s", map $age->($_), $server, $multi, $http);
-}
-
-
sub cmd_notifications { # $arg = '' or 'on' or 'off'
return unless &mymaster;
if($_[ARG] =~ /^on$/i) {
@@ -369,50 +408,3 @@ sub cmd_notifications { # $arg = '' or 'on' or 'off'
}
-sub cmd_say { # $arg = '[#chan ]text', no #chan = $dest
- return unless &mymaster;
- my $chan = $_[ARG] =~ s/^(#[a-zA-Z0-9-_.]+) // ? $1 : $_[DEST];
- $_[KERNEL]->post(circ => privmsg => $chan, $_[ARG]);
-}
-
-
-sub cmd_me { # same as cmd_say, but CTCP ACTION
- return unless &mymaster;
- my $chan = $_[ARG] =~ s/^(#[a-zA-Z0-9-_.]+) // ? $1 : $_[DEST];
- $_[KERNEL]->post(circ => ctcp => $chan, 'ACTION '.$_[ARG]);
-}
-
-
-sub cmd_cmd { # TODO: feedback?
- return unless &mymaster;
- $_[KERNEL]->post(core => queue => $_[ARG]);
- $_[KERNEL]->post(circ => privmsg => $_[DEST] => sprintf "Executing %s", $_[ARG]);
-}
-
-
-sub cmd_eval { # the evil cmd
- return unless &mymaster;
- $_[KERNEL]->post(circ => privmsg => $_[DEST], 'eval: '.$_)
- for (split /\r?\n/, eval($_[ARG])||$@);
-}
-
-
-
-
-# non-POE function, checks whether we should trust $nick
-sub mymaster { # same @_ as the cmd_ functions
- if(!$_[HEAP]{irc}->is_channel_operator($_[HEAP]{o}{channel}[0], $_[ARG2])
- && !$_[HEAP]{irc}->is_channel_owner($_[HEAP]{o}{channel}[0], $_[ARG2])
- && !$_[HEAP]{irc}->is_channel_admin($_[HEAP]{o}{channel}[0], $_[ARG2])
- || ($_[HEAP]{o}{master_users} && !grep lc($_) eq lc($_[ARG2]), @{$_[HEAP]{o}{master_users}})
- ) {
- $_[KERNEL]->post(circ => privmsg => $_[ARG1],
- ($_[ARG1]=~/^#/?$_[ARG2].', ':'').'You are not my master!');
- return 0;
- }
- return 1;
-}
-
-1;
-
-