Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

We’re showing branches in this repository, but you can also compare across forks.

base fork: pasky/papalala
base: 816c9f413d
...
head fork: pasky/papalala
compare: b79e52907d
  • 12 commits
  • 11 files changed
  • 0 commit comments
  • 2 contributors
3  DEPS
View
@@ -0,0 +1,3 @@
+Perl modules:
+Hailo
+Cstocs
10 IDOS.pm
View
@@ -1,6 +1,7 @@
package IDOS::RouteQuery;
# This class handles IDOS route queries.
+# API: http://www.chaps.cz/idos-moznost-vyuziti-odkazu.asp
use Moose;
use Moose::Util::TypeConstraints;
@@ -12,7 +13,7 @@ has 'region' => (is => 'rw', isa => 'Region', required => 1);
has 'origin' => (is => 'rw', isa => 'Str', required => 1);
has 'dest' => (is => 'rw', isa => 'Str', required => 1);
has 'thru' => (is => 'rw', isa => 'Str');
-# has 'when' => (is => 'rw', isa => 'Str', default => sub { time });
+has 'later' => (is => 'rw', isa => 'Num', default => 0); # number of minutes after now
sub execute {
my $self = shift;
@@ -20,6 +21,12 @@ sub execute {
my @routes;
my %qpar = (f => $self->origin(), t => $self->dest(), v => $self->thru());
+ if ($self->later() > 0) {
+ my @t0 = localtime(time);
+ my @t1 = localtime(time + $self->later() * 60);
+ $qpar{date} = sprintf('%d.%d.%04d', $t1[3], $t1[4] + 1, $t1[5] + 1900);
+ $qpar{time} = sprintf('%d:%02d', $t1[2], $t1[1]);
+ }
my @qpar = map {
my $val = $qpar{$_};
if (defined $val) {
@@ -78,6 +85,7 @@ sub execute {
if ($places[$_]->{line} =~ /esun/) {
($d, $a) = ($places[$_]->{arrival}, $places[$_+1]->{departure});
}
+ $places[$_]->{line} ||= 'wtf';
my %r = (
'start' => $d, 'origin' => $places[$_]->{place},
'stop' => $a, 'dest' => $places[$_+1]->{place},
12 README
View
@@ -3,16 +3,12 @@ a collection of irssi scripts providing various IRC services, and some
supporting infrastructure.
To run this thing, symlink everything in irssi/ to ~/.irssi/ and run
-irssi from the root directory of this tree.
+irssi from the root directory of this tree. (or run: irssi --home $WHERE)
-irssi/ - the scripts themselves
+Best way to learn chatbot new words is using hailo command bundled with
+Hailo perl module, just be sure to save brain in $IRSSIHOME/papalala.brn
-build_brain.pl - Megahal training from logs (by default, Megahal is
- trained from conversations with it)
-filter_logs.pl - Megahal log preprocessing for build_brain.pl
-update_ban.pl - Megahal automatic word banlist extraction from logs
-megahal_tcp.pl - Megahal server for the megahal script; must be running
- for Megahal to work
+irssi/ - the scripts themselves
wordstats.sql - SQL schema for the wordstats script; feed sqlite to
initialize the database
15 build_brain.pl
View
@@ -1,15 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use warnings;
-use Megahal;
-my $counter = 0;
-
-unlink qw(megahal.brn megahal.dic megahal.log megahal.txt);
-
-Megahal::megahal_initialize();
-
-while (<>) {
- Megahal::megahal_learn_no_reply($_, 0);
-}
-
-Megahal::megahal_cleanup();
41 filter_logs.pl
View
@@ -1,41 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use warnings;
-use Megahal;
-
-my $logpath = $ENV{'HOME'}.'/irclogs/IRCnet';
-my @channels = glob "$logpath/#programatori* $logpath/#linux.cz*";
-my $maxlines = shift or 40000;
-my @bots = qw(Etingo dev_null Papalala Muaddib); # bots and trolls to ignore, case-insensitive
-
-while (my $channel = shift @channels) {
- open my $input, $channel
- or die "Can't open log";
-
- my $counter = $maxlines;
-
- while (<$input>) {
- next
- if(/^---/); ## Zmeny data
- s/^\d{8} \d\d:\d\d:\d\d//; ## Ustrihnout datum
- next
- unless (/^</); ## Pokud nikdo nemluvi
- s/^<.([^>]*)>\s*(\S+[:,>]+)?\s*//; ## Odstrani nicky, az na samotnou hranici textu
- next
- if grep( lc($1) eq lc($_) , @bots); # strip bots etc
-# + pripadne dalsi komupisu:
- next
- if (/^\s*$/); ## prazdny radek
-
- last
- unless $counter--;
-
- print;
-
- if ($counter % 1000 == 0) {
- printf STDERR "%i files and %i lines (cur. file) to go\n",
- scalar @channels, $counter;
- }
- }
- close $channel;
-}
1  irssi/scripts/autorun/fight.pl
View
1  irssi/scripts/autorun/google.pl
View
60 irssi/scripts/chatbot.pl
View
@@ -1,14 +1,11 @@
-###### TODO
-## add multiple server support
-
use strict;
use warnings;
use Irssi;
use Irssi::Irc;
-use IO::Socket::INET;
use Time::HiRes qw(usleep gettimeofday tv_interval);
+use Hailo;
use vars qw($VERSION %IRSSI);
@@ -20,29 +17,30 @@
description => "megahal connector",
);
-our $megahal;
+our $hailo;
sub on_msg {
my ($server, $message, $nick, $hostmask, $channel) = @_;
my $mynick = $server->{nick};
my $isprivate = !defined $channel;
my $dst = $isprivate ? $nick : $channel;
+ my $trigger_chance = Irssi::settings_get_int('bot_megahal_triggerchance');
my $request;
return if grep {lc eq lc $nick} split(/ /, Irssi::settings_get_str('bot_megahal_ignore'));
+
if ($message !~ s/^\s*$mynick[,:]\s*(.*)$/$1/i) {
- return
- unless Irssi::settings_get_int('bot_megahal_triggerchance');
- return
- if (int(rand(Irssi::settings_get_int('bot_megahal_triggerchance'))));
- # With very small chance, we will reply to the user.
+ if (!$trigger_chance or int(rand($trigger_chance))) {
+ Irssi::settings_get_bool('bot_megahal_learn_from_all') and $hailo->learn($message);
+ return;
+ }
}
# Ensure we do not reply ridiculously quickly:
my $delay = Irssi::settings_get_int('bot_megahal_mindelay');
my $t0 = [gettimeofday()];
- my $response = megahal_response($message);
+ my $response = $hailo->learn_reply($message);
my $dt = tv_interval($t0, [gettimeofday()]) * 1000000;
@@ -52,45 +50,15 @@ sub on_msg {
$server->send_message($dst, "$nick: $response", 0);
}
-sub megahal_response {
- my ($data) = @_;
- $data =~ s/\s+/ /;
- $data =~ s/\s*$/\n/;
-
- megahal_connect() unless defined $megahal;
-
- return ">> Can't connect to megahal, try latter or alert my master"
- unless defined $megahal;
-
- if ($data =~ /koureni.*nekoureni/i) {
- return "Bez do haje.";
- }
-
- $megahal->printflush($data);
- my $response = $megahal->getline;
-
- if (! defined $response) {
- $megahal = undef;
- goto &megahal_response; ## restart
- }
-
- chomp($response);
- return $response;
-}
-
-sub megahal_connect {
- my $address = Irssi::settings_get_str('bot_megahal');
- $megahal = IO::Socket::INET->new(
- PeerAddr => $address,
- Type => SOCK_STREAM,
- );
-}
-
Irssi::signal_add('message public', 'on_msg');
Irssi::signal_add('message private', 'on_msg');
-Irssi::settings_add_str('bot', 'bot_megahal', 'localhost:4566');
Irssi::settings_add_str('bot', 'bot_megahal_ignore', '');
# minimal response time in microseconds
Irssi::settings_add_int('bot', 'bot_megahal_mindelay', 0);
+Irssi::settings_add_bool('bot', 'bot_megahal_learn_from_all', 1);
Irssi::settings_add_int('bot', 'bot_megahal_triggerchance', 1000);
+
+##
+$hailo = Hailo->new(brain => Irssi::get_irssi_dir()."/papalala.brn");
+
2  irssi/scripts/decide.pl
View
@@ -27,7 +27,7 @@ sub on_msg {
return unless $message =~ s/^${cp}decide\s*//;
my $time = time();
- if ($time - $lastt > 60*60*48) {
+ if ($time - $lastt > 300) {
$lastt = $time;
}
5 irssi/scripts/idos.pl
View
@@ -48,12 +48,15 @@ sub on_msg {
return;
}
+ my $later = 2;
+ $later = 5 if ($args[0] eq 'brmlab');
@args = map { s/brmlab/Vltavska;Stross nam/; $_; } @args;
my %par = (
region => $region,
origin => $args[0],
- dest => $args[1]
+ dest => $args[1],
+ later => $later
);
$par{thru} = $args[2] if $args[2];
my $q = IDOS::RouteQuery->new(%par);
60 megahal_tcp.pl
View
@@ -1,60 +0,0 @@
-#!/usr/bin/perl
-# fork son which run megahal and periodically restarts, to avoid memleaks
-
-use warnings;
-use strict;
-
-use IO::Socket::INET;
-
-my $save_interval = 3600;
-my $socket;
-
-sub run_megahal {
- use Megahal;
-
- $SIG{ALRM} = sub {Megahal::megahal_cleanup; exit 0;};
- alarm $save_interval;
-
- Megahal::megahal_initialize();
-
- print "Hal started\n";
-
- while (my $client = $socket->accept) {
- print "Client connected\n";
- while (my $line = $client->getline) {
- print "Get line: $line";
- chomp($line);
-
- my $response = Megahal::megahal_do_reply($line, 0);
- $response =~ s/\s+/ /;
- $response =~ s/\s*$/\n/;
-
- print "Responding with: $response";
-
- $client->printflush($response);
- }
- }
-}
-
-$socket = IO::Socket::INET->new(
- LocalAddr => ":4566",
- Type => SOCK_STREAM,
- ReuseAddr => 1,
- Listen => 1,
-);
-
-while (1) {
- my $pid = fork;
-
- if (!defined $pid) {
- die $!;
- }
- elsif ($pid) {
- wait;
- sleep 1;
- }
- else {
- run_megahal;
- }
-}
-

No commit comments for this range

Something went wrong with that request. Please try again.