Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, 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
View
3  DEPS
@@ -0,0 +1,3 @@
+Perl modules:
+Hailo
+Cstocs
View
10 IDOS.pm
@@ -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},
View
12 README
@@ -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
View
15 build_brain.pl
@@ -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();
View
41 filter_logs.pl
@@ -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;
-}
View
1  irssi/scripts/autorun/fight.pl
View
1  irssi/scripts/autorun/google.pl
View
60 irssi/scripts/chatbot.pl
@@ -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");
+
View
2  irssi/scripts/decide.pl
@@ -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;
}
View
5 irssi/scripts/idos.pl
@@ -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);
View
60 megahal_tcp.pl
@@ -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.