karma.pl

• package main
  • public
  • own_public
  • karma_add
  • karma_rem
  • query
  • update
• EOF

use strict;
use vars qw($VERSION %IRSSI);

use Irssi;

$VERSION = '1.05';

# 1.00
#   Initial release.
# 1.01
#   Fixed regex matches for single tokens
# 1.02
#   Added own_public sub to catch own messages.
# 1.03
#   Added !karma querying ability
# 1.04
#   Irssi::get_irssi_dir() works.
# 1.05
#   Filtering through lc() to avoid havoc!

%IRSSI = (
    authors	=> 'Jared Burke',
    contact	=> 'Jared@anal0g.org',
    name	=> 'Karma',
    description	=> 'Karma',
    license	=> 'Public Domain',
    url		=> 'http://anal0g.org/dev',
    changed	=> 'Tue Jun 27 09:14 CET 2008',
);

my $directory = Irssi::get_irssi_dir() . "/karma";
mkdir $directory or die "$directory: $!" unless -d $directory;

sub public {
    my ($server, $msg, $nick, $address, $target) = @_;
    if ($msg =~ /^\w+\+\+$/s) {
	$msg =~ s/\+\+$//;
	karma_add($msg);
	$server->command('msg ' . $target . ' ' . $msg . '\'s new karma is ' . query($msg));
	return 0;
    }
    elsif ($msg =~ /^\w+--$/s) {
	$msg =~ s/--$//;
	karma_rem($msg);
	$server->command('msg ' . $target . ' ' . $msg . '\'s new karma is ' . query($msg));
	return 0;
    }
    elsif ($msg =~ /^\!karma \w+$/s) {
	$msg =~ s/^\!karma //;
	$server->command('msg ' . $target . ' ' . $msg . '\'s karma is ' . query($msg));
    }
}

sub own_public {
    my ($server, $msg, $target) = @_;
    if ($msg =~ /^\w+\+\+$/s) {
        $msg =~ s/\+\+$//;
	karma_add($msg);
        $server->command('msg ' . $target . ' ' . $msg . '\'s new karma is ' . query($msg));
        return 0;
    }
    elsif ($msg =~ /^\w+--$/) {
        $msg =~ s/--$//;
        karma_rem($msg);
	$server->command('msg ' . $target . ' ' . $msg . '\'s new karma is ' . query($msg));
        return 0;
    }
    elsif ($msg =~ /^!karma \w+$/s) {
	$msg =~s/^\!karma //;
        $server->command('msg ' . $target . ' ' . $msg. '\'s karma is ' . query($msg));
    }
}

sub karma_add {
    my $target = @_[0];
    my $old_karma = query($target);
    my $new_karma = $old_karma + 1;
    update($target,$new_karma);
}

sub karma_rem {
    my $target = @_[0];
    my $old_karma = query($target);
    my $new_karma = $old_karma - 1;
    update($target,$new_karma);
}

sub query {
    my $target = $directory . "/" . lc(@_[0]);
    if (-e $target) {
	open FILE, $target or die "$target: $!";
	my $value = <FILE>;
	close(FILE);
	return $value;
    }
    else {
	return 0;
    }
}

sub update {
    my ($target, $value) = @_;
    $target = lc($target);
    # This is lazy.
    `touch $directory/$target` unless -e "$directory/$target";
    # This is even lazier.
    `echo $value > $directory/$target`;
}

Irssi::signal_add("message public", "public");
Irssi::signal_add("message own_public", "own_public");